core: multiple users api (#1679)
* 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
GitHub
parent
f68d8fd97c
commit
fa9e0086f6
@ -1611,7 +1611,7 @@ sealed class CC {
|
||||
val cmdString: String get() = when (this) {
|
||||
is Console -> cmd
|
||||
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 ApiStopChat -> "/_stop"
|
||||
is SetFilesFolder -> "/_files_folder $filesFolder"
|
||||
|
||||
@ -95,7 +95,7 @@ public enum ChatCommand {
|
||||
get {
|
||||
switch self {
|
||||
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 .apiStopChat: return "/_stop"
|
||||
case .apiActivateChat: return "/_app activate"
|
||||
|
||||
@ -450,7 +450,7 @@ export function cmdString(cmd: ChatCommand): string {
|
||||
case "showActiveUser":
|
||||
return "/u"
|
||||
case "createActiveUser":
|
||||
return `/u ${JSON.stringify(cmd.profile)}`
|
||||
return `/create user ${JSON.stringify(cmd.profile)}`
|
||||
case "startChat":
|
||||
return `/_start subscribe=${cmd.subscribeConnections ? "on" : "off"} expire=${cmd.expireChatItems ? "on" : "off"}`
|
||||
case "apiStopChat":
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -24,10 +24,10 @@ chatBotRepl welcome answer _user cc = do
|
||||
race_ (forever $ void getLine) . forever $ do
|
||||
(_, resp) <- atomically . readTBQueue $ outputQ cc
|
||||
case resp of
|
||||
CRContactConnected contact _ -> do
|
||||
CRContactConnected _ contact _ -> do
|
||||
contactConnected contact
|
||||
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
|
||||
void . sendMsg contact $ answer msg
|
||||
_ -> pure ()
|
||||
@ -38,11 +38,11 @@ chatBotRepl welcome answer _user cc = do
|
||||
initializeBotAddress :: ChatController -> IO ()
|
||||
initializeBotAddress cc = do
|
||||
sendChatCmd cc "/show_address" >>= \case
|
||||
CRUserContactLink UserContactLink {connReqContact} -> showBotAddress connReqContact
|
||||
CRChatCmdError (ChatErrorStore SEUserContactLinkNotFound) -> do
|
||||
CRUserContactLink _ UserContactLink {connReqContact} -> showBotAddress connReqContact
|
||||
CRChatCmdError _ (ChatErrorStore SEUserContactLinkNotFound) -> do
|
||||
putStrLn "No bot address, creating..."
|
||||
sendChatCmd cc "/address" >>= \case
|
||||
CRUserContactLinkCreated uri -> showBotAddress uri
|
||||
CRUserContactLinkCreated _ uri -> showBotAddress uri
|
||||
_ -> putStrLn "can't create bot address" >> exitFailure
|
||||
_ -> putStrLn "unexpected response" >> exitFailure
|
||||
where
|
||||
|
||||
@ -140,6 +140,11 @@ instance ToJSON HelpSection where
|
||||
data ChatCommand
|
||||
= ShowActiveUser
|
||||
| CreateActiveUser Profile
|
||||
| ListUsers
|
||||
| APISetActiveUser UserId
|
||||
| SetActiveUser UserName
|
||||
| APIDeleteUser UserId
|
||||
| DeleteUser UserName
|
||||
| StartChat {subscribeConnections :: Bool, enableExpireChatItems :: Bool}
|
||||
| APIStopChat
|
||||
| APIActivateChat
|
||||
@ -153,7 +158,7 @@ data ChatCommand
|
||||
| APIStorageEncryption DBEncryptionConfig
|
||||
| ExecChatStoreSQL Text
|
||||
| ExecAgentStoreSQL Text
|
||||
| APIGetChats {pendingConnections :: Bool}
|
||||
| APIGetChats {pendingConnections :: Bool} -- UserId
|
||||
| APIGetChat ChatRef ChatPagination (Maybe String)
|
||||
| APIGetChatItems Int
|
||||
| APISendMessage {chatRef :: ChatRef, liveMessage :: Bool, composedMessage :: ComposedMessage}
|
||||
@ -172,9 +177,9 @@ data ChatCommand
|
||||
| APISendCallAnswer ContactId WebRTCSession
|
||||
| APISendCallExtraInfo ContactId WebRTCExtraInfo
|
||||
| APIEndCall ContactId
|
||||
| APIGetCallInvitations
|
||||
| APIGetCallInvitations -- UserId
|
||||
| APICallStatus ContactId WebRTCCallStatus
|
||||
| APIUpdateProfile Profile
|
||||
| APIUpdateProfile Profile -- UserId
|
||||
| APISetContactPrefs ContactId Preferences
|
||||
| APISetContactAlias ContactId LocalAlias
|
||||
| APISetConnectionAlias Int64 LocalAlias
|
||||
@ -183,7 +188,7 @@ data ChatCommand
|
||||
| APIRegisterToken DeviceToken NotificationsMode
|
||||
| APIVerifyToken DeviceToken C.CbNonce ByteString
|
||||
| APIDeleteToken DeviceToken
|
||||
| APIGetNtfMessage {nonce :: C.CbNonce, encNtfInfo :: ByteString}
|
||||
| APIGetNtfMessage {nonce :: C.CbNonce, encNtfInfo :: ByteString} -- UserId
|
||||
| APIAddMember GroupId ContactId GroupMemberRole
|
||||
| APIJoinGroup GroupId
|
||||
| APIMemberRole GroupId GroupMemberId GroupMemberRole
|
||||
@ -194,11 +199,11 @@ data ChatCommand
|
||||
| APICreateGroupLink GroupId
|
||||
| APIDeleteGroupLink GroupId
|
||||
| APIGetGroupLink GroupId
|
||||
| GetUserSMPServers
|
||||
| SetUserSMPServers SMPServersConfig
|
||||
| GetUserSMPServers -- UserId
|
||||
| SetUserSMPServers SMPServersConfig -- UserId
|
||||
| TestSMPServer SMPServerWithAuth
|
||||
| APISetChatItemTTL (Maybe Int64)
|
||||
| APIGetChatItemTTL
|
||||
| APISetChatItemTTL (Maybe Int64) -- UserId
|
||||
| APIGetChatItemTTL -- UserId
|
||||
| APISetNetworkConfig NetworkConfig
|
||||
| APIGetNetworkConfig
|
||||
| APISetChatSettings ChatRef ChatSettings
|
||||
@ -221,26 +226,26 @@ data ChatCommand
|
||||
| VerifyGroupMember GroupName ContactName (Maybe Text)
|
||||
| ChatHelp HelpSection
|
||||
| Welcome
|
||||
| AddContact
|
||||
| Connect (Maybe AConnectionRequestUri)
|
||||
| ConnectSimplex
|
||||
| AddContact -- UserId
|
||||
| Connect (Maybe AConnectionRequestUri) -- UserId
|
||||
| ConnectSimplex -- UserId
|
||||
| DeleteContact ContactName
|
||||
| ClearContact ContactName
|
||||
| ListContacts
|
||||
| CreateMyAddress
|
||||
| DeleteMyAddress
|
||||
| ShowMyAddress
|
||||
| AddressAutoAccept (Maybe AutoAccept)
|
||||
| ListContacts -- UserId
|
||||
| CreateMyAddress -- UserId
|
||||
| DeleteMyAddress -- UserId
|
||||
| ShowMyAddress -- UserId
|
||||
| AddressAutoAccept (Maybe AutoAccept) -- UserId
|
||||
| AcceptContact ContactName
|
||||
| RejectContact ContactName
|
||||
| SendMessage ChatName ByteString
|
||||
| SendLiveMessage ChatName ByteString
|
||||
| SendMessageQuote {contactName :: ContactName, msgDir :: AMsgDirection, quotedMsg :: ByteString, message :: ByteString}
|
||||
| SendMessageBroadcast ByteString
|
||||
| SendMessageBroadcast ByteString -- UserId
|
||||
| DeleteMessage ChatName ByteString
|
||||
| EditMessage {chatName :: ChatName, editedMsg :: ByteString, message :: ByteString}
|
||||
| UpdateLiveMessage {chatName :: ChatName, chatItemId :: ChatItemId, liveMessage :: Bool, message :: ByteString}
|
||||
| NewGroup GroupProfile
|
||||
| NewGroup GroupProfile -- UserId
|
||||
| AddMember GroupName ContactName GroupMemberRole
|
||||
| JoinGroup GroupName
|
||||
| MemberRole GroupName ContactName GroupMemberRole
|
||||
@ -249,7 +254,7 @@ data ChatCommand
|
||||
| DeleteGroup GroupName
|
||||
| ClearGroup GroupName
|
||||
| ListMembers GroupName
|
||||
| ListGroups
|
||||
| ListGroups -- UserId
|
||||
| UpdateGroupNames GroupName GroupProfile
|
||||
| ShowGroupProfile GroupName
|
||||
| UpdateGroupDescription GroupName (Maybe Text)
|
||||
@ -257,9 +262,9 @@ data ChatCommand
|
||||
| DeleteGroupLink GroupName
|
||||
| ShowGroupLink GroupName
|
||||
| SendGroupMessageQuote {groupName :: GroupName, contactName_ :: Maybe ContactName, quotedMsg :: ByteString, message :: ByteString}
|
||||
| LastMessages (Maybe ChatName) Int (Maybe String)
|
||||
| LastChatItemId (Maybe ChatName) Int
|
||||
| ShowChatItem (Maybe ChatItemId)
|
||||
| LastMessages (Maybe ChatName) Int (Maybe String) -- UserId
|
||||
| LastChatItemId (Maybe ChatName) Int -- UserId
|
||||
| ShowChatItem (Maybe ChatItemId) -- UserId
|
||||
| ShowLiveItems Bool
|
||||
| SendFile ChatName FilePath
|
||||
| SendImage ChatName FilePath
|
||||
@ -268,13 +273,13 @@ data ChatCommand
|
||||
| ReceiveFile {fileId :: FileTransferId, fileInline :: Maybe Bool, filePath :: Maybe FilePath}
|
||||
| CancelFile FileTransferId
|
||||
| FileStatus FileTransferId
|
||||
| ShowProfile
|
||||
| UpdateProfile ContactName Text
|
||||
| UpdateProfileImage (Maybe ImageData)
|
||||
| SetUserFeature AChatFeature FeatureAllowed
|
||||
| ShowProfile -- UserId
|
||||
| UpdateProfile ContactName Text -- UserId
|
||||
| UpdateProfileImage (Maybe ImageData) -- UserId
|
||||
| SetUserFeature AChatFeature FeatureAllowed -- UserId
|
||||
| SetContactFeature AChatFeature ContactName (Maybe FeatureAllowed)
|
||||
| SetGroupFeature AGroupFeature GroupName GroupFeatureEnabled
|
||||
| SetUserTimedMessages Bool
|
||||
| SetUserTimedMessages Bool -- UserId
|
||||
| SetContactTimedMessages ContactName (Maybe TimedMessagesEnabled)
|
||||
| SetGroupTimedMessages GroupName (Maybe Int)
|
||||
| QuitChat
|
||||
@ -286,137 +291,138 @@ data ChatCommand
|
||||
|
||||
data ChatResponse
|
||||
= CRActiveUser {user :: User}
|
||||
| CRUsersList {users :: [User]}
|
||||
| CRChatStarted
|
||||
| CRChatRunning
|
||||
| CRChatStopped
|
||||
| CRChatSuspended
|
||||
| CRApiChats {chats :: [AChat]}
|
||||
| CRApiChat {chat :: AChat}
|
||||
| CRChatItems {chatItems :: [AChatItem]}
|
||||
| CRChatItemId (Maybe ChatItemId)
|
||||
| CRApiChats {user :: User, chats :: [AChat]}
|
||||
| CRApiChat {user :: User, chat :: AChat}
|
||||
| CRChatItems {user :: User, chatItems :: [AChatItem]}
|
||||
| CRChatItemId User (Maybe ChatItemId)
|
||||
| CRApiParsedMarkdown {formattedText :: Maybe MarkdownList}
|
||||
| CRUserSMPServers {smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth}
|
||||
| CRUserSMPServers {user :: User, smpServers :: NonEmpty ServerCfg, presetSMPServers :: NonEmpty SMPServerWithAuth}
|
||||
| CRSmpTestResult {smpTestFailure :: Maybe SMPTestFailure}
|
||||
| CRChatItemTTL {chatItemTTL :: Maybe Int64}
|
||||
| CRChatItemTTL {user :: User, chatItemTTL :: Maybe Int64}
|
||||
| CRNetworkConfig {networkConfig :: NetworkConfig}
|
||||
| CRContactInfo {contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
|
||||
| CRGroupMemberInfo {groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
|
||||
| CRContactSwitch {contact :: Contact, switchProgress :: SwitchProgress}
|
||||
| CRGroupMemberSwitch {groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
|
||||
| CRContactCode {contact :: Contact, connectionCode :: Text}
|
||||
| CRGroupMemberCode {groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text}
|
||||
| CRConnectionVerified {verified :: Bool, expectedCode :: Text}
|
||||
| CRNewChatItem {chatItem :: AChatItem}
|
||||
| CRChatItemStatusUpdated {chatItem :: AChatItem}
|
||||
| CRChatItemUpdated {chatItem :: AChatItem}
|
||||
| CRChatItemDeleted {deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
|
||||
| CRChatItemDeletedNotFound {contact :: Contact, sharedMsgId :: SharedMsgId}
|
||||
| CRBroadcastSent MsgContent Int ZonedTime
|
||||
| CRMsgIntegrityError {msgError :: MsgErrorType}
|
||||
| CRContactInfo {user :: User, contact :: Contact, connectionStats :: ConnectionStats, customUserProfile :: Maybe Profile}
|
||||
| CRGroupMemberInfo {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionStats_ :: Maybe ConnectionStats}
|
||||
| CRContactSwitch {user :: User, contact :: Contact, switchProgress :: SwitchProgress}
|
||||
| CRGroupMemberSwitch {user :: User, groupInfo :: GroupInfo, member :: GroupMember, switchProgress :: SwitchProgress}
|
||||
| CRContactCode {user :: User, contact :: Contact, connectionCode :: Text}
|
||||
| CRGroupMemberCode {user :: User, groupInfo :: GroupInfo, member :: GroupMember, connectionCode :: Text}
|
||||
| CRConnectionVerified {user :: User, verified :: Bool, expectedCode :: Text}
|
||||
| CRNewChatItem {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemStatusUpdated {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemUpdated {user :: User, chatItem :: AChatItem}
|
||||
| CRChatItemDeleted {user :: User, deletedChatItem :: AChatItem, toChatItem :: Maybe AChatItem, byUser :: Bool, timed :: Bool}
|
||||
| CRChatItemDeletedNotFound {user :: User, contact :: Contact, sharedMsgId :: SharedMsgId}
|
||||
| CRBroadcastSent User MsgContent Int ZonedTime
|
||||
| CRMsgIntegrityError {user :: User, msgError :: MsgErrorType}
|
||||
| CRCmdAccepted {corr :: CorrId}
|
||||
| CRCmdOk
|
||||
| CRCmdOk {user_ :: Maybe User}
|
||||
| CRChatHelp {helpSection :: HelpSection}
|
||||
| CRWelcome {user :: User}
|
||||
| CRGroupCreated {groupInfo :: GroupInfo}
|
||||
| CRGroupMembers {group :: Group}
|
||||
| CRContactsList {contacts :: [Contact]}
|
||||
| CRUserContactLink {contactLink :: UserContactLink}
|
||||
| CRUserContactLinkUpdated {contactLink :: UserContactLink}
|
||||
| CRContactRequestRejected {contactRequest :: UserContactRequest}
|
||||
| CRUserAcceptedGroupSent {groupInfo :: GroupInfo, hostContact :: Maybe Contact}
|
||||
| CRUserDeletedMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupsList {groups :: [GroupInfo]}
|
||||
| CRSentGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
|
||||
| CRFileTransferStatus (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
|
||||
| CRUserProfile {profile :: Profile}
|
||||
| CRUserProfileNoChange
|
||||
| CRGroupCreated {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupMembers {user :: User, group :: Group}
|
||||
| CRContactsList {user :: User, contacts :: [Contact]}
|
||||
| CRUserContactLink {user :: User, contactLink :: UserContactLink}
|
||||
| CRUserContactLinkUpdated {user :: User, contactLink :: UserContactLink}
|
||||
| CRContactRequestRejected {user :: User, contactRequest :: UserContactRequest}
|
||||
| CRUserAcceptedGroupSent {user :: User, groupInfo :: GroupInfo, hostContact :: Maybe Contact}
|
||||
| CRUserDeletedMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupsList {user :: User, groups :: [GroupInfo]}
|
||||
| CRSentGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, member :: GroupMember}
|
||||
| CRFileTransferStatus User (FileTransfer, [Integer]) -- TODO refactor this type to FileTransferStatus
|
||||
| CRUserProfile {user :: User, profile :: Profile}
|
||||
| CRUserProfileNoChange {user :: User}
|
||||
| CRVersionInfo {version :: String}
|
||||
| CRInvitation {connReqInvitation :: ConnReqInvitation}
|
||||
| CRSentConfirmation
|
||||
| CRSentInvitation {customUserProfile :: Maybe Profile}
|
||||
| CRContactUpdated {fromContact :: Contact, toContact :: Contact}
|
||||
| CRContactsMerged {intoContact :: Contact, mergedContact :: Contact}
|
||||
| CRContactDeleted {contact :: Contact}
|
||||
| CRChatCleared {chatInfo :: AChatInfo}
|
||||
| CRUserContactLinkCreated {connReqContact :: ConnReqContact}
|
||||
| CRUserContactLinkDeleted
|
||||
| CRReceivedContactRequest {contactRequest :: UserContactRequest}
|
||||
| CRAcceptingContactRequest {contact :: Contact}
|
||||
| CRContactAlreadyExists {contact :: Contact}
|
||||
| CRContactRequestAlreadyAccepted {contact :: Contact}
|
||||
| CRLeftMemberUser {groupInfo :: GroupInfo}
|
||||
| CRGroupDeletedUser {groupInfo :: GroupInfo}
|
||||
| CRRcvFileAccepted {chatItem :: AChatItem}
|
||||
| CRRcvFileAcceptedSndCancelled {rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileStart {chatItem :: AChatItem}
|
||||
| CRRcvFileComplete {chatItem :: AChatItem}
|
||||
| CRRcvFileCancelled {rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileSndCancelled {rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRSndFileStart {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileComplete {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRInvitation {user :: User, connReqInvitation :: ConnReqInvitation}
|
||||
| CRSentConfirmation {user :: User}
|
||||
| CRSentInvitation {user :: User, customUserProfile :: Maybe Profile}
|
||||
| CRContactUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
|
||||
| CRContactsMerged {user :: User, intoContact :: Contact, mergedContact :: Contact}
|
||||
| CRContactDeleted {user :: User, contact :: Contact}
|
||||
| CRChatCleared {user :: User, chatInfo :: AChatInfo}
|
||||
| CRUserContactLinkCreated {user :: User, connReqContact :: ConnReqContact}
|
||||
| CRUserContactLinkDeleted {user :: User}
|
||||
| CRReceivedContactRequest {user :: User, contactRequest :: UserContactRequest}
|
||||
| CRAcceptingContactRequest {user :: User, contact :: Contact}
|
||||
| CRContactAlreadyExists {user :: User, contact :: Contact}
|
||||
| CRContactRequestAlreadyAccepted {user :: User, contact :: Contact}
|
||||
| CRLeftMemberUser {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupDeletedUser {user :: User, groupInfo :: GroupInfo}
|
||||
| CRRcvFileAccepted {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileAcceptedSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileStart {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileComplete {user :: User, chatItem :: AChatItem}
|
||||
| CRRcvFileCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRRcvFileSndCancelled {user :: User, rcvFileTransfer :: RcvFileTransfer}
|
||||
| CRSndFileStart {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileComplete {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndFileRcvCancelled {chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndGroupFileCancelled {chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
|
||||
| CRUserProfileUpdated {fromProfile :: Profile, toProfile :: Profile}
|
||||
| CRContactAliasUpdated {toContact :: Contact}
|
||||
| CRConnectionAliasUpdated {toConnection :: PendingContactConnection}
|
||||
| CRContactPrefsUpdated {fromContact :: Contact, toContact :: Contact}
|
||||
| CRContactConnecting {contact :: Contact}
|
||||
| CRContactConnected {contact :: Contact, userCustomProfile :: Maybe Profile}
|
||||
| CRContactAnotherClient {contact :: Contact}
|
||||
| CRSubscriptionEnd {connectionEntity :: ConnectionEntity}
|
||||
| CRContactsDisconnected {server :: SMPServer, contactRefs :: [ContactRef]}
|
||||
| CRContactsSubscribed {server :: SMPServer, contactRefs :: [ContactRef]}
|
||||
| CRSndFileRcvCancelled {user :: User, chatItem :: AChatItem, sndFileTransfer :: SndFileTransfer}
|
||||
| CRSndGroupFileCancelled {user :: User, chatItem :: AChatItem, fileTransferMeta :: FileTransferMeta, sndFileTransfers :: [SndFileTransfer]}
|
||||
| CRUserProfileUpdated {user :: User, fromProfile :: Profile, toProfile :: Profile}
|
||||
| CRContactAliasUpdated {user :: User, toContact :: Contact}
|
||||
| CRConnectionAliasUpdated {user :: User, toConnection :: PendingContactConnection}
|
||||
| CRContactPrefsUpdated {user :: User, fromContact :: Contact, toContact :: Contact}
|
||||
| CRContactConnecting {user :: User, contact :: Contact}
|
||||
| CRContactConnected {user :: User, contact :: Contact, userCustomProfile :: Maybe Profile}
|
||||
| CRContactAnotherClient {user :: User, contact :: Contact}
|
||||
| CRSubscriptionEnd {user :: User, connectionEntity :: ConnectionEntity}
|
||||
| CRContactsDisconnected {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
|
||||
| CRContactsSubscribed {user :: User, server :: SMPServer, contactRefs :: [ContactRef]}
|
||||
| CRContactSubError {contact :: Contact, chatError :: ChatError}
|
||||
| CRContactSubSummary {contactSubscriptions :: [ContactSubStatus]}
|
||||
| CRUserContactSubSummary {userContactSubscriptions :: [UserContactSubStatus]}
|
||||
| CRHostConnected {protocol :: AProtocolType, transportHost :: TransportHost}
|
||||
| CRHostDisconnected {protocol :: AProtocolType, transportHost :: TransportHost}
|
||||
| CRGroupInvitation {groupInfo :: GroupInfo}
|
||||
| CRReceivedGroupInvitation {groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
|
||||
| CRUserJoinedGroup {groupInfo :: GroupInfo, hostMember :: GroupMember}
|
||||
| CRJoinedGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRJoinedGroupMemberConnecting {groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
|
||||
| CRMemberRole {groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMemberRoleUser {groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRConnectedToGroupMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRDeletedMember {groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
|
||||
| CRDeletedMemberUser {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRLeftMember {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRReceivedGroupInvitation {user :: User, groupInfo :: GroupInfo, contact :: Contact, memberRole :: GroupMemberRole}
|
||||
| CRUserJoinedGroup {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember}
|
||||
| CRJoinedGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRJoinedGroupMemberConnecting {user :: User, groupInfo :: GroupInfo, hostMember :: GroupMember, member :: GroupMember}
|
||||
| CRMemberRole {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRMemberRoleUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember, fromRole :: GroupMemberRole, toRole :: GroupMemberRole}
|
||||
| CRConnectedToGroupMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRDeletedMember {user :: User, groupInfo :: GroupInfo, byMember :: GroupMember, deletedMember :: GroupMember}
|
||||
| CRDeletedMemberUser {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRLeftMember {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupEmpty {groupInfo :: GroupInfo}
|
||||
| CRGroupRemoved {groupInfo :: GroupInfo}
|
||||
| CRGroupDeleted {groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupUpdated {fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
|
||||
| CRGroupProfile {groupInfo :: GroupInfo}
|
||||
| CRGroupLinkCreated {groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
|
||||
| CRGroupLink {groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
|
||||
| CRGroupLinkDeleted {groupInfo :: GroupInfo}
|
||||
| CRAcceptingGroupJoinRequest {groupInfo :: GroupInfo, contact :: Contact}
|
||||
| CRGroupDeleted {user :: User, groupInfo :: GroupInfo, member :: GroupMember}
|
||||
| CRGroupUpdated {user :: User, fromGroup :: GroupInfo, toGroup :: GroupInfo, member_ :: Maybe GroupMember}
|
||||
| CRGroupProfile {user :: User, groupInfo :: GroupInfo}
|
||||
| CRGroupLinkCreated {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
|
||||
| CRGroupLink {user :: User, groupInfo :: GroupInfo, connReqContact :: ConnReqContact}
|
||||
| CRGroupLinkDeleted {user :: User, groupInfo :: GroupInfo}
|
||||
| CRAcceptingGroupJoinRequest {user :: User, groupInfo :: GroupInfo, contact :: Contact}
|
||||
| CRMemberSubError {groupInfo :: GroupInfo, member :: GroupMember, chatError :: ChatError}
|
||||
| CRMemberSubSummary {memberSubscriptions :: [MemberSubStatus]}
|
||||
| CRGroupSubscribed {groupInfo :: GroupInfo}
|
||||
| CRPendingSubSummary {pendingSubscriptions :: [PendingSubStatus]}
|
||||
| CRSndFileSubError {sndFileTransfer :: SndFileTransfer, chatError :: ChatError}
|
||||
| CRRcvFileSubError {rcvFileTransfer :: RcvFileTransfer, chatError :: ChatError}
|
||||
| CRCallInvitation {callInvitation :: RcvCallInvitation}
|
||||
| CRCallOffer {contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
|
||||
| CRCallAnswer {contact :: Contact, answer :: WebRTCSession}
|
||||
| CRCallExtraInfo {contact :: Contact, extraInfo :: WebRTCExtraInfo}
|
||||
| CRCallEnded {contact :: Contact}
|
||||
| CRCallInvitations {callInvitations :: [RcvCallInvitation]}
|
||||
| CRCallInvitation {user :: User, callInvitation :: RcvCallInvitation}
|
||||
| CRCallOffer {user :: User, contact :: Contact, callType :: CallType, offer :: WebRTCSession, sharedKey :: Maybe C.Key, askConfirmation :: Bool}
|
||||
| CRCallAnswer {user :: User, contact :: Contact, answer :: WebRTCSession}
|
||||
| CRCallExtraInfo {user :: User, contact :: Contact, extraInfo :: WebRTCExtraInfo}
|
||||
| CRCallEnded {user :: User, contact :: Contact}
|
||||
| CRCallInvitations {user :: User, callInvitations :: [RcvCallInvitation]}
|
||||
| CRUserContactLinkSubscribed
|
||||
| CRUserContactLinkSubError {chatError :: ChatError}
|
||||
| CRNtfTokenStatus {status :: NtfTknStatus}
|
||||
| CRNtfToken {token :: DeviceToken, status :: NtfTknStatus, ntfMode :: NotificationsMode}
|
||||
| CRNtfMessages {connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
|
||||
| CRNewContactConnection {connection :: PendingContactConnection}
|
||||
| CRContactConnectionDeleted {connection :: PendingContactConnection}
|
||||
| CRNtfMessages {user :: User, connEntity :: Maybe ConnectionEntity, msgTs :: Maybe UTCTime, ntfMessages :: [NtfMsgInfo]}
|
||||
| CRNewContactConnection {user :: User, connection :: PendingContactConnection}
|
||||
| CRContactConnectionDeleted {user :: User, connection :: PendingContactConnection}
|
||||
| CRSQLResult {rows :: [Text]}
|
||||
| CRDebugLocks {chatLockName :: Maybe String, agentLocks :: AgentLocks}
|
||||
| CRAgentStats {agentStats :: [[String]]}
|
||||
| CRMessageError {severity :: Text, errorMessage :: Text}
|
||||
| CRChatCmdError {chatError :: ChatError}
|
||||
| CRChatError {chatError :: ChatError}
|
||||
| CRMessageError {user :: User, severity :: Text, errorMessage :: Text}
|
||||
| CRChatCmdError {user_ :: Maybe User, chatError :: ChatError}
|
||||
| CRChatError {user_ :: Maybe User, chatError :: ChatError}
|
||||
deriving (Show, Generic)
|
||||
|
||||
instance ToJSON ChatResponse where
|
||||
@ -551,7 +557,8 @@ instance ToJSON ChatError where
|
||||
|
||||
data ChatErrorType
|
||||
= CENoActiveUser
|
||||
| CEActiveUserExists
|
||||
| CENoConnectionUser {agentConnId :: AgentConnId}
|
||||
| CEActiveUserExists -- TODO delete
|
||||
| CEChatNotStarted
|
||||
| CEChatNotStopped
|
||||
| CEChatStoreChanged
|
||||
@ -627,8 +634,8 @@ throwDBError = throwError . ChatErrorDatabase
|
||||
|
||||
type ChatMonad m = (MonadUnliftIO m, MonadReader ChatController m, MonadError ChatError m)
|
||||
|
||||
chatCmdError :: String -> ChatResponse
|
||||
chatCmdError = CRChatCmdError . ChatError . CECommandError
|
||||
chatCmdError :: Maybe User -> String -> ChatResponse
|
||||
chatCmdError user = CRChatCmdError user . ChatError . CECommandError
|
||||
|
||||
setActive :: (MonadUnliftIO m, MonadReader ChatController m) => ActiveTo -> m ()
|
||||
setActive to = asks activeTo >>= atomically . (`writeTVar` to)
|
||||
|
||||
@ -28,6 +28,9 @@ module Simplex.Chat.Store
|
||||
createUser,
|
||||
getUsers,
|
||||
setActiveUser,
|
||||
getSetActiveUser,
|
||||
getUserIdByName,
|
||||
getUserByAConnId,
|
||||
createDirectConnection,
|
||||
createConnReqConnection,
|
||||
getProfileById,
|
||||
@ -440,15 +443,16 @@ createUser db Profile {displayName, fullName, image, preferences = userPreferenc
|
||||
|
||||
getUsers :: DB.Connection -> IO [User]
|
||||
getUsers db =
|
||||
map toUser
|
||||
<$> DB.query_
|
||||
db
|
||||
[sql|
|
||||
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
|
||||
FROM users u
|
||||
JOIN contacts c ON u.contact_id = c.contact_id
|
||||
JOIN contact_profiles p ON c.contact_profile_id = p.contact_profile_id
|
||||
|]
|
||||
map toUser <$> DB.query_ db userQuery
|
||||
|
||||
userQuery :: Query
|
||||
userQuery =
|
||||
[sql|
|
||||
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
|
||||
FROM users u
|
||||
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, 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 = 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 userId acId cReqHash xContactId incognitoProfile groupLinkId = do
|
||||
createdAt <- getCurrentTime
|
||||
@ -4803,7 +4827,9 @@ randomBytes gVar = atomically . stateTVar gVar . randomBytesGenerate
|
||||
-- These error type constructors must be added to mobile apps
|
||||
data StoreError
|
||||
= SEDuplicateName
|
||||
| SEContactNotFound {contactId :: Int64}
|
||||
| SEUserNotFound {userId :: UserId}
|
||||
| SEUserNotFoundByName {contactName :: ContactName}
|
||||
| SEContactNotFound {contactId :: ContactId}
|
||||
| SEContactNotFoundByName {contactName :: ContactName}
|
||||
| SEContactNotReady {contactName :: ContactName}
|
||||
| SEDuplicateContactLink
|
||||
|
||||
@ -43,7 +43,8 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
|
||||
unless (isMessage cmd) $ echo s
|
||||
r <- runReaderT (execChatCommand bs) cc
|
||||
case r of
|
||||
CRChatCmdError _ -> when (isMessage cmd) $ echo s
|
||||
CRChatCmdError _ _ -> when (isMessage cmd) $ echo s
|
||||
CRChatError _ _ -> when (isMessage cmd) $ echo s
|
||||
_ -> pure ()
|
||||
printRespToTerminal ct cc False r
|
||||
startLiveMessage cmd r
|
||||
@ -58,7 +59,7 @@ runInputLoop ct@ChatTerminal {termState, liveMessageState} cc = forever $ do
|
||||
Right SendMessageBroadcast {} -> True
|
||||
_ -> False
|
||||
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
|
||||
let s = T.unpack $ safeDecodeUtf8 msg
|
||||
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
|
||||
let bs = encodeUtf8 $ T.pack sentMsg
|
||||
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 ct cc = withChatTerm ct $ do
|
||||
|
||||
@ -95,8 +95,8 @@ runTerminalOutput ct cc@ChatController {outputQ, showLiveItems} = do
|
||||
forever $ do
|
||||
(_, r) <- atomically $ readTBQueue outputQ
|
||||
case r of
|
||||
CRNewChatItem ci -> markChatItemRead ci
|
||||
CRChatItemUpdated ci -> markChatItemRead ci
|
||||
CRNewChatItem _ ci -> markChatItemRead ci
|
||||
CRChatItemUpdated _ ci -> markChatItemRead ci
|
||||
_ -> pure ()
|
||||
liveItems <- readTVarIO showLiveItems
|
||||
printRespToTerminal ct cc liveItems r
|
||||
|
||||
@ -216,6 +216,8 @@ instance ToJSON ConnReqUriHash where
|
||||
|
||||
data ContactOrRequest = CORContact Contact | CORRequest UserContactRequest
|
||||
|
||||
type UserName = Text
|
||||
|
||||
type ContactName = Text
|
||||
|
||||
type GroupName = Text
|
||||
|
||||
@ -59,35 +59,36 @@ serializeChatResponse user_ ts = unlines . map unStyle . responseToView user_ Fa
|
||||
responseToView :: Maybe User -> Bool -> Bool -> CurrentTime -> ChatResponse -> [StyledString]
|
||||
responseToView user_ testView liveItems ts = \case
|
||||
CRActiveUser User {profile} -> viewUserProfile $ fromLocalProfile profile
|
||||
CRUsersList users -> viewUsersList users
|
||||
CRChatStarted -> ["chat started"]
|
||||
CRChatRunning -> ["chat is running"]
|
||||
CRChatStopped -> ["chat stopped"]
|
||||
CRChatSuspended -> ["chat suspended"]
|
||||
CRApiChats 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]
|
||||
CRApiChats _u chats -> if testView then testViewChats chats else [plain . bshow $ J.encode chats]
|
||||
CRApiChat _u chat -> if testView then testViewChat chat else [plain . bshow $ J.encode chat]
|
||||
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
|
||||
CRChatItemTTL ttl -> viewChatItemTTL ttl
|
||||
CRChatItemTTL _u ttl -> viewChatItemTTL ttl
|
||||
CRNetworkConfig cfg -> viewNetworkConfig cfg
|
||||
CRContactInfo ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile
|
||||
CRGroupMemberInfo g m cStats -> viewGroupMemberInfo g m cStats
|
||||
CRContactSwitch ct progress -> viewContactSwitch ct progress
|
||||
CRGroupMemberSwitch g m progress -> viewGroupMemberSwitch g m progress
|
||||
CRConnectionVerified verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode ct code -> viewContactCode ct code testView
|
||||
CRGroupMemberCode g m code -> viewGroupMemberCode g m code testView
|
||||
CRNewChatItem (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts
|
||||
CRChatItems chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||
CRChatItemId itemId -> [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated _ -> []
|
||||
CRChatItemUpdated (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
|
||||
CRChatItemDeletedNotFound Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent mc n t -> viewSentBroadcast mc n ts t
|
||||
CRMsgIntegrityError mErr -> viewMsgIntegrityError mErr
|
||||
CRContactInfo _u ct cStats customUserProfile -> viewContactInfo ct cStats customUserProfile
|
||||
CRGroupMemberInfo _u g m cStats -> viewGroupMemberInfo g m cStats
|
||||
CRContactSwitch _u ct progress -> viewContactSwitch ct progress
|
||||
CRGroupMemberSwitch _u g m progress -> viewGroupMemberSwitch g m progress
|
||||
CRConnectionVerified _u verified code -> [plain $ if verified then "connection verified" else "connection not verified, current code is " <> code]
|
||||
CRContactCode _u ct code -> viewContactCode ct code testView
|
||||
CRGroupMemberCode _u g m code -> viewGroupMemberCode g m code testView
|
||||
CRNewChatItem _u (AChatItem _ _ chat item) -> unmuted chat item $ viewChatItem chat item False ts
|
||||
CRChatItems _u chatItems -> concatMap (\(AChatItem _ _ chat item) -> viewChatItem chat item True ts) chatItems
|
||||
CRChatItemId _u itemId -> [plain $ maybe "no item" show itemId]
|
||||
CRChatItemStatusUpdated _u _ -> []
|
||||
CRChatItemUpdated _u (AChatItem _ _ chat item) -> unmuted chat item $ viewItemUpdate chat item liveItems ts
|
||||
CRChatItemDeleted _u (AChatItem _ _ chat deletedItem) toItem byUser timed -> unmuted chat deletedItem $ viewItemDelete chat deletedItem (isJust toItem) byUser timed ts
|
||||
CRChatItemDeletedNotFound _u Contact {localDisplayName = c} _ -> [ttyFrom $ c <> "> [deleted - original message not found]"]
|
||||
CRBroadcastSent _u mc n t -> viewSentBroadcast mc n ts t
|
||||
CRMsgIntegrityError _u mErr -> viewMsgIntegrityError mErr
|
||||
CRCmdAccepted _ -> []
|
||||
CRCmdOk -> ["ok"]
|
||||
CRCmdOk _u -> ["ok"]
|
||||
CRChatHelp section -> case section of
|
||||
HSMain -> chatHelpInfo
|
||||
HSFiles -> filesHelpInfo
|
||||
@ -97,65 +98,64 @@ responseToView user_ testView liveItems ts = \case
|
||||
HSMarkdown -> markdownInfo
|
||||
HSSettings -> settingsInfo
|
||||
CRWelcome user -> chatWelcome user
|
||||
CRContactsList cs -> viewContactsList cs
|
||||
CRUserContactLink UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
CRUserContactLinkUpdated UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept
|
||||
CRContactRequestRejected UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
|
||||
CRGroupCreated g -> viewGroupCreated g
|
||||
CRGroupMembers g -> viewGroupMembers g
|
||||
CRGroupsList gs -> viewGroupsList gs
|
||||
CRSentGroupInvitation g c _ ->
|
||||
CRContactsList _u cs -> viewContactsList cs
|
||||
CRUserContactLink _u UserContactLink {connReqContact, autoAccept} -> connReqContact_ "Your chat address:" connReqContact <> autoAcceptStatus_ autoAccept
|
||||
CRUserContactLinkUpdated _u UserContactLink {autoAccept} -> autoAcceptStatus_ autoAccept
|
||||
CRContactRequestRejected _u UserContactRequest {localDisplayName = c} -> [ttyContact c <> ": contact request rejected"]
|
||||
CRGroupCreated _u g -> viewGroupCreated g
|
||||
CRGroupMembers _u g -> viewGroupMembers g
|
||||
CRGroupsList _u gs -> viewGroupsList gs
|
||||
CRSentGroupInvitation _u g c _ ->
|
||||
if viaGroupLink . contactConn $ c
|
||||
then [ttyContact' c <> " invited to group " <> ttyGroup' g <> " via your group link"]
|
||||
else ["invitation to join the group " <> ttyGroup' g <> " sent to " <> ttyContact' c]
|
||||
CRFileTransferStatus ftStatus -> viewFileTransferStatus ftStatus
|
||||
CRUserProfile p -> viewUserProfile p
|
||||
CRUserProfileNoChange -> ["user profile did not change"]
|
||||
CRFileTransferStatus _u ftStatus -> viewFileTransferStatus ftStatus
|
||||
CRUserProfile _u p -> viewUserProfile p
|
||||
CRUserProfileNoChange _u -> ["user profile did not change"]
|
||||
CRVersionInfo _ -> [plain versionStr, plain updateStr]
|
||||
CRChatCmdError e -> viewChatError e
|
||||
CRInvitation cReq -> viewConnReqInvitation cReq
|
||||
CRSentConfirmation -> ["confirmation sent!"]
|
||||
CRSentInvitation customUserProfile -> viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted c -> [ttyContact' c <> ": contact is deleted"]
|
||||
CRChatCleared chatInfo -> viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest c -> [ttyFullContact c <> ": accepting contact request..."]
|
||||
CRContactAlreadyExists c -> [ttyFullContact c <> ": contact already exists"]
|
||||
CRContactRequestAlreadyAccepted c -> [ttyFullContact c <> ": sent you a duplicate contact request, but you are already connected, no action needed"]
|
||||
CRUserContactLinkCreated cReq -> connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted -> viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent _g _ -> [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser g -> [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileAccepted ci -> savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled ft -> viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled _ ftm fts -> viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled ft -> receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated p p' -> viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated {fromContact, toContact} -> case user_ of
|
||||
CRInvitation _u cReq -> viewConnReqInvitation cReq
|
||||
CRSentConfirmation _u -> ["confirmation sent!"]
|
||||
CRSentInvitation _u customUserProfile -> viewSentInvitation customUserProfile testView
|
||||
CRContactDeleted _u c -> [ttyContact' c <> ": contact is deleted"]
|
||||
CRChatCleared _u chatInfo -> viewChatCleared chatInfo
|
||||
CRAcceptingContactRequest _u c -> [ttyFullContact c <> ": accepting contact request..."]
|
||||
CRContactAlreadyExists _u 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"]
|
||||
CRUserContactLinkCreated _u cReq -> connReqContact_ "Your new chat address is created!" cReq
|
||||
CRUserContactLinkDeleted _u -> viewUserContactLinkDeleted
|
||||
CRUserAcceptedGroupSent _u _g _ -> [] -- [ttyGroup' g <> ": joining the group..."]
|
||||
CRUserDeletedMember _u g m -> [ttyGroup' g <> ": you removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMemberUser _u g -> [ttyGroup' g <> ": you left the group"] <> groupPreserved g
|
||||
CRGroupDeletedUser _u g -> [ttyGroup' g <> ": you deleted the group"]
|
||||
CRRcvFileAccepted _u ci -> savingFile' ci
|
||||
CRRcvFileAcceptedSndCancelled _u ft -> viewRcvFileSndCancelled ft
|
||||
CRSndGroupFileCancelled _u _ ftm fts -> viewSndGroupFileCancelled ftm fts
|
||||
CRRcvFileCancelled _u ft -> receivingFile_ "cancelled" ft
|
||||
CRUserProfileUpdated _u p p' -> viewUserProfileUpdated p p'
|
||||
CRContactPrefsUpdated {user = _u, fromContact, toContact} -> case user_ of
|
||||
Just user -> viewUserContactPrefsUpdated user fromContact toContact
|
||||
_ -> ["unexpected chat event CRContactPrefsUpdated without current user"]
|
||||
CRContactAliasUpdated c -> viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated c -> viewConnectionAliasUpdated c
|
||||
CRContactUpdated {fromContact = c, toContact = c'} -> case user_ of
|
||||
CRContactAliasUpdated _u c -> viewContactAliasUpdated c
|
||||
CRConnectionAliasUpdated _u c -> viewConnectionAliasUpdated c
|
||||
CRContactUpdated {user = _u, fromContact = c, toContact = c'} -> case user_ of
|
||||
Just user -> viewContactUpdated c c' <> viewContactPrefsUpdated user c c'
|
||||
_ -> ["unexpected chat event CRContactUpdated without current user"]
|
||||
CRContactsMerged intoCt mergedCt -> viewContactsMerged intoCt mergedCt
|
||||
CRReceivedContactRequest UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
|
||||
CRRcvFileStart ci -> receivingFile_' "started" ci
|
||||
CRRcvFileComplete ci -> receivingFile_' "completed" ci
|
||||
CRRcvFileSndCancelled ft -> viewRcvFileSndCancelled ft
|
||||
CRSndFileStart _ ft -> sendingFile_ "started" ft
|
||||
CRSndFileComplete _ ft -> sendingFile_ "completed" ft
|
||||
CRContactsMerged _u intoCt mergedCt -> viewContactsMerged intoCt mergedCt
|
||||
CRReceivedContactRequest _u UserContactRequest {localDisplayName = c, profile} -> viewReceivedContactRequest c profile
|
||||
CRRcvFileStart _u ci -> receivingFile_' "started" ci
|
||||
CRRcvFileComplete _u ci -> receivingFile_' "completed" ci
|
||||
CRRcvFileSndCancelled _u ft -> viewRcvFileSndCancelled ft
|
||||
CRSndFileStart _u _ ft -> sendingFile_ "started" ft
|
||||
CRSndFileComplete _u _ ft -> sendingFile_ "completed" ft
|
||||
CRSndFileCancelled _ ft -> sendingFile_ "cancelled" ft
|
||||
CRSndFileRcvCancelled _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
CRSndFileRcvCancelled _u _ ft@SndFileTransfer {recipientDisplayName = c} ->
|
||||
[ttyContact c <> " cancelled receiving " <> sndFile ft]
|
||||
CRContactConnecting _ -> []
|
||||
CRContactConnected ct userCustomProfile -> viewContactConnected ct userCustomProfile testView
|
||||
CRContactAnotherClient c -> [ttyContact' c <> ": contact is connected to another client"]
|
||||
CRSubscriptionEnd acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
|
||||
CRContactsDisconnected srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactsSubscribed srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactConnecting _u _ -> []
|
||||
CRContactConnected _u ct userCustomProfile -> viewContactConnected ct userCustomProfile testView
|
||||
CRContactAnotherClient _u c -> [ttyContact' c <> ": contact is connected to another client"]
|
||||
CRSubscriptionEnd _u acEntity -> [sShow (connId (entityConnection acEntity :: Connection)) <> ": END"]
|
||||
CRContactsDisconnected _u srv cs -> [plain $ "server disconnected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactsSubscribed _u srv cs -> [plain $ "server connected " <> showSMPServer srv <> " (" <> contactList cs <> ")"]
|
||||
CRContactSubError c e -> [ttyContact' c <> ": contact error " <> sShow e]
|
||||
CRContactSubSummary summary ->
|
||||
[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
|
||||
(groupLinkErrors, groupLinksSubscribed) = partition (isJust . userContactError) groupLinks
|
||||
CRGroupInvitation g -> [groupInvitation' g]
|
||||
CRReceivedGroupInvitation g c role -> viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup g _ -> viewUserJoinedGroup g
|
||||
CRJoinedGroupMember g m -> viewJoinedGroupMember g m
|
||||
CRReceivedGroupInvitation _u g c role -> viewReceivedGroupInvitation g c role
|
||||
CRUserJoinedGroup _u g _ -> viewUserJoinedGroup g
|
||||
CRJoinedGroupMember _u g m -> viewJoinedGroupMember g m
|
||||
CRHostConnected p h -> [plain $ "connected to " <> 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...)"]
|
||||
CRConnectedToGroupMember g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole g by m r r' -> viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser g m r r' -> viewMemberRoleUserChanged g m r r'
|
||||
CRDeletedMemberUser 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"]
|
||||
CRLeftMember g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRJoinedGroupMemberConnecting _u g host m -> [ttyGroup' g <> ": " <> ttyMember host <> " added " <> ttyFullMember m <> " to the group (connecting...)"]
|
||||
CRConnectedToGroupMember _u g m -> [ttyGroup' g <> ": " <> connectedMember m <> " is connected"]
|
||||
CRMemberRole _u g by m r r' -> viewMemberRoleChanged g by m r r'
|
||||
CRMemberRoleUser _u g m r r' -> viewMemberRoleUserChanged g m r r'
|
||||
CRDeletedMemberUser _u g by -> [ttyGroup' g <> ": " <> ttyMember by <> " removed you from the group"] <> groupPreserved g
|
||||
CRDeletedMember _u g by m -> [ttyGroup' g <> ": " <> ttyMember by <> " removed " <> ttyMember m <> " from the group"]
|
||||
CRLeftMember _u g m -> [ttyGroup' g <> ": " <> ttyMember m <> " left the group"]
|
||||
CRGroupEmpty g -> [ttyFullGroup g <> ": group is empty"]
|
||||
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"]
|
||||
CRGroupUpdated g g' m -> viewGroupUpdated g g' m
|
||||
CRGroupProfile g -> viewGroupProfile g
|
||||
CRGroupLinkCreated g cReq -> groupLink_ "Group link is created!" g cReq
|
||||
CRGroupLink g cReq -> groupLink_ "Group link:" g cReq
|
||||
CRGroupLinkDeleted g -> viewGroupLinkDeleted g
|
||||
CRAcceptingGroupJoinRequest g c -> [ttyFullContact c <> ": accepting request to join group " <> ttyGroup' g <> "..."]
|
||||
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 _u g g' m -> viewGroupUpdated g g' m
|
||||
CRGroupProfile _u g -> viewGroupProfile g
|
||||
CRGroupLinkCreated _u g cReq -> groupLink_ "Group link is created!" g cReq
|
||||
CRGroupLink _u g cReq -> groupLink_ "Group link:" g cReq
|
||||
CRGroupLinkDeleted _u g -> viewGroupLinkDeleted 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]
|
||||
CRMemberSubSummary summary -> viewErrorsSummary (filter (isJust . memberError) summary) " group member errors"
|
||||
CRGroupSubscribed g -> viewGroupSubscribed g
|
||||
@ -198,16 +198,16 @@ responseToView user_ testView liveItems ts = \case
|
||||
["sent file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||
CRRcvFileSubError RcvFileTransfer {fileId, fileInvitation = FileInvitation {fileName}} e ->
|
||||
["received file " <> sShow fileId <> " (" <> plain fileName <> ") error: " <> sShow e]
|
||||
CRCallInvitation RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey
|
||||
CRCallOffer {contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey
|
||||
CRCallAnswer {contact, answer} -> viewCallAnswer contact answer
|
||||
CRCallExtraInfo {contact} -> ["call extra info from " <> ttyContact' contact]
|
||||
CRCallEnded {contact} -> ["call with " <> ttyContact' contact <> " ended"]
|
||||
CRCallInvitations _ -> []
|
||||
CRCallInvitation _u RcvCallInvitation {contact, callType, sharedKey} -> viewCallInvitation contact callType sharedKey
|
||||
CRCallOffer {user = _u, contact, callType, offer, sharedKey} -> viewCallOffer contact callType offer sharedKey
|
||||
CRCallAnswer {user = _u, contact, answer} -> viewCallAnswer contact answer
|
||||
CRCallExtraInfo {user = _u, contact} -> ["call extra info from " <> ttyContact' contact]
|
||||
CRCallEnded {user = _u, contact} -> ["call with " <> ttyContact' contact <> " ended"]
|
||||
CRCallInvitations _u _ -> []
|
||||
CRUserContactLinkSubscribed -> ["Your address is active! To show: " <> highlight' "/sa"]
|
||||
CRUserContactLinkSubError e -> ["user address error: " <> sShow e, "to delete your address: " <> highlight' "/da"]
|
||||
CRNewContactConnection _ -> []
|
||||
CRContactConnectionDeleted PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"]
|
||||
CRNewContactConnection _u _ -> []
|
||||
CRContactConnectionDeleted _u PendingContactConnection {pccConnId} -> ["connection :" <> sShow pccConnId <> " deleted"]
|
||||
CRNtfTokenStatus status -> ["device token status: " <> plain (smpEncode status)]
|
||||
CRNtfToken _ status mode -> ["device token status: " <> plain (smpEncode status) <> ", notifications mode: " <> plain (strEncode mode)]
|
||||
CRNtfMessages {} -> []
|
||||
@ -217,8 +217,9 @@ responseToView user_ testView liveItems ts = \case
|
||||
plain $ "agent locks: " <> LB.unpack (J.encode agentLocks)
|
||||
]
|
||||
CRAgentStats stats -> map (plain . intercalate ",") stats
|
||||
CRMessageError prefix err -> [plain prefix <> ": " <> plain err]
|
||||
CRChatError e -> viewChatError e
|
||||
CRMessageError _u prefix err -> [plain prefix <> ": " <> plain err]
|
||||
CRChatCmdError _u e -> viewChatError e
|
||||
CRChatError _u e -> viewChatError e
|
||||
where
|
||||
testViewChats :: [AChat] -> [StyledString]
|
||||
testViewChats chats = [sShow $ map toChatView chats]
|
||||
@ -256,6 +257,13 @@ responseToView user_ testView liveItems ts = \case
|
||||
| muted chat chatItem = []
|
||||
| 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 chat ChatItem {chatDir} = case (chat, chatDir) of
|
||||
(DirectChat Contact {chatSettings = DisableNtfs}, CIDirectRcv) -> True
|
||||
@ -1130,6 +1138,7 @@ viewChatError :: ChatError -> [StyledString]
|
||||
viewChatError = \case
|
||||
ChatError err -> case err of
|
||||
CENoActiveUser -> ["error: active user is required"]
|
||||
CENoConnectionUser _agentConnId -> [] -- ["error: connection has no user, conn id: " <> sShow agentConnId]
|
||||
CEActiveUserExists -> ["error: active user already exists"]
|
||||
CEChatNotStarted -> ["error: chat not started"]
|
||||
CEChatNotStopped -> ["error: chat not stopped"]
|
||||
@ -1179,6 +1188,7 @@ viewChatError = \case
|
||||
-- e -> ["chat error: " <> sShow e]
|
||||
ChatErrorStore err -> case err of
|
||||
SEDuplicateName -> ["this display name is already used by user, contact or group"]
|
||||
SEUserNotFoundByName u -> ["no user " <> ttyContact u]
|
||||
SEContactNotFoundByName c -> ["no contact " <> ttyContact c]
|
||||
SEContactNotReady c -> ["contact " <> ttyContact c <> " is not active yet"]
|
||||
SEGroupNotFoundByName g -> ["no group " <> ttyGroup g]
|
||||
|
||||
@ -25,9 +25,9 @@ noActiveUser = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"e
|
||||
|
||||
activeUserExists :: String
|
||||
#if defined(darwin_HOST_OS) && defined(swiftJSON)
|
||||
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"error\":{\"errorType\":{\"activeUserExists\":{}}}}}}}"
|
||||
activeUserExists = "{\"resp\":{\"chatCmdError\":{\"chatError\":{\"errorStore\":{\"storeError\":{\"duplicateName\":{}}}}}}}"
|
||||
#else
|
||||
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"error\",\"errorType\":{\"type\":\"activeUserExists\"}}}}"
|
||||
activeUserExists = "{\"resp\":{\"type\":\"chatCmdError\",\"chatError\":{\"type\":\"errorStore\",\"storeError\":{\"type\":\"duplicateName\"}}}}"
|
||||
#endif
|
||||
|
||||
activeUser :: String
|
||||
@ -85,7 +85,7 @@ testChatApiNoUser = withTmpFiles $ do
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit testDBPrefix "myKey"
|
||||
chatSendCmd cc "/u" `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
|
||||
|
||||
testChatApi :: IO ()
|
||||
@ -98,7 +98,7 @@ testChatApi = withTmpFiles $ do
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix ""
|
||||
Left (DBMErrorNotADatabase _) <- chatMigrateInit dbPrefix "anotherKey"
|
||||
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
|
||||
chatRecvMsg cc `shouldReturn` contactSubSummary
|
||||
chatRecvMsg cc `shouldReturn` userContactSubSummary
|
||||
|
||||
Loading…
Reference in New Issue
Block a user