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

Revert "remoteHostId in backend"

Browse Source 
This reverts commit 72654caca6.
This commit is contained in:
spaced4ndy
2023-11-20 19:56:31 +04:00
parent 72654caca6
commit 11478da6ef
13 changed files with 44 additions and 267 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
src/Simplex/Chat.hs
View File

@@ -1069,7 +1069,7 @@ processChatCommand = \case
callState = CallInvitationSent {localCallType = callType, localDhPrivKey = snd <$> dhKeyPair}
(msg, _) <- sendDirectContactMessage ct (XCallInv callId invitation)
ci <- saveSndChatItem user (CDDirectSnd ct) msg (CISndCall CISCallPending 0)
let call' = Call {remoteHostId = Nothing, contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
let call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
call_ <- atomically $ TM.lookupInsert contactId call' calls
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
toView $ CRNewChatItem user (AChatItem SCTDirect SMDSnd (DirectChat ct) ci)
@@ -1141,7 +1141,7 @@ processChatCommand = \case
rcvCallInvitation (contactId, callTs, peerCallType, sharedKey) = runExceptT . withStore $ \db -> do
user <- getUserByContactId db contactId
contact <- getContact db user contactId
pure RcvCallInvitation {remoteHostId = Nothing, user, contact, callType = peerCallType, sharedKey, callTs}
pure RcvCallInvitation {user, contact, callType = peerCallType, sharedKey, callTs}
APIGetNetworkStatuses -> withUser $ \_ ->
CRNetworkStatuses Nothing . map (uncurry ConnNetworkStatus) . M.toList <$> chatReadVar connNetworkStatuses
APICallStatus contactId receivedStatus ->
@@ -1186,7 +1186,7 @@ processChatCommand = \case
servers' = fromMaybe (L.map toServerCfg defServers) $ nonEmpty servers
pure $ CRUserProtoServers user $ AUPS $ UserProtoServers p servers' defServers
where
toServerCfg server = ServerCfg {remoteHostId = Nothing, server, preset = True, tested = Nothing, enabled = True}
toServerCfg server = ServerCfg {server, preset = True, tested = Nothing, enabled = True}
GetUserProtoServers aProtocol -> withUser $ \User {userId} ->
processChatCommand $ APIGetUserProtoServers userId aProtocol
APISetUserProtoServers userId (APSC p (ProtoServersConfig servers)) -> withUserId userId $ \user -> withServerProtocol p $
@@ -4766,7 +4766,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
ci <- saveCallItem CISCallPending
let sharedKey = C.Key . C.dhBytes' <$> (C.dh' <$> callDhPubKey <*> (snd <$> dhKeyPair))
callState = CallInvitationReceived {peerCallType = callType, localDhPubKey = fst <$> dhKeyPair, sharedKey}
call' = Call {remoteHostId = Nothing, contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
call' = Call {contactId, callId, chatItemId = chatItemId' ci, callState, callTs = chatItemTs' ci}
calls <- asks currentCalls
-- theoretically, the new call invitation for the current contact can mark the in-progress call as ended
-- (and replace it in ChatController)
@@ -4774,7 +4774,7 @@ processAgentMessageConn user@User {userId} corrId agentConnId agentMessage = do
withStore' $ \db -> createCall db user call' $ chatItemTs' ci
call_ <- atomically (TM.lookupInsert contactId call' calls)
forM_ call_ $ \call -> updateCallItemStatus user ct call WCSDisconnected Nothing
toView $ CRCallInvitation RcvCallInvitation {remoteHostId = Nothing, user, contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
toView $ CRCallInvitation RcvCallInvitation {user, contact = ct, callType, sharedKey, callTs = chatItemTs' ci}
toView $ CRNewChatItem user $ AChatItem SCTDirect SMDRcv (DirectChat ct) ci
else featureRejected CFCalls
where
@@ -6314,7 +6314,7 @@ chatCommandP =
(Just <$> (AutoAccept <$> (" incognito=" *> onOffP <|> pure False) <*> optional (A.space *> msgContentP)))
(pure Nothing)
srvCfgP = strP >>= \case AProtocolType p -> APSC p <$> (A.space *> jsonP)
toServerCfg server = ServerCfg {remoteHostId = Nothing, server, preset = False, tested = Nothing, enabled = True}
toServerCfg server = ServerCfg {server, preset = False, tested = Nothing, enabled = True}
char_ = optional . A.char
adminContactReq :: ConnReqContact

8
src/Simplex/Chat/Call.hs
View File

@@ -20,15 +20,14 @@ import Data.Text (Text)
import Data.Time.Clock (UTCTime)
import Database.SQLite.Simple.FromField (FromField (..))
import Database.SQLite.Simple.ToField (ToField (..))
import Simplex.Chat.Types (Contact, ContactId, User, RemoteHostId)
import Simplex.Chat.Types (Contact, ContactId, User)
import Simplex.Chat.Types.Util (decodeJSON, encodeJSON)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Encoding.String
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, fromTextField_, fstToLower, singleFieldJSON)
data Call = Call
{ remoteHostId :: Maybe RemoteHostId,
contactId :: ContactId,
{ contactId :: ContactId,
callId :: CallId,
chatItemId :: Int64,
callState :: CallState,
@@ -108,8 +107,7 @@ instance FromField CallId where fromField f = CallId <$> fromField f
instance ToField CallId where toField (CallId m) = toField m
data RcvCallInvitation = RcvCallInvitation
{ remoteHostId :: Maybe RemoteHostId,
user :: User,
{ user :: User,
contact :: Contact,
callType :: CallType,
sharedKey :: Maybe C.Key,

3
src/Simplex/Chat/Messages.hs
View File

@@ -266,8 +266,7 @@ data NewChatItem d = NewChatItem
-- | type to show one chat with messages
data Chat c = Chat
{ remoteHostId :: Maybe RemoteHostId,
chatInfo :: ChatInfo c,
{ chatInfo :: ChatInfo c,
chatItems :: [CChatItem c],
chatStats :: ChatStats
}

6
src/Simplex/Chat/Remote.hs
View File

@@ -225,7 +225,7 @@ startRemoteHost rh_ = do
pollEvents rhId rhClient = do
oq <- asks outputQ
forever $ do
r_ <- liftRH rhId $ remoteRecv rhId rhClient 10000000
r_ <- liftRH rhId $ remoteRecv rhClient 10000000
forM r_ $ \r -> atomically $ writeTBQueue oq (Nothing, Just rhId, r)
httpError :: RemoteHostId -> HTTP2ClientError -> ChatError
httpError rhId = ChatErrorRemoteHost (RHId rhId) . RHEProtocolError . RPEHTTP2 . tshow
@@ -359,13 +359,13 @@ processRemoteCommand :: ChatMonad m => RemoteHostId -> RemoteHostClient -> ChatC
processRemoteCommand remoteHostId c cmd s = case cmd of
SendFile chatName f -> sendFile "/f" chatName f
SendImage chatName f -> sendFile "/img" chatName f
_ -> liftRH remoteHostId $ remoteSend remoteHostId c s
_ -> liftRH remoteHostId $ remoteSend c s
where
sendFile cmdName chatName (CryptoFile path cfArgs) = do
-- don't encrypt in host if already encrypted locally
CryptoFile path' cfArgs' <- storeRemoteFile remoteHostId (cfArgs $> False) path
let f = CryptoFile path' (cfArgs <|> cfArgs') -- use local or host encryption
liftRH remoteHostId $ remoteSend remoteHostId c $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
liftRH remoteHostId $ remoteSend c $ B.unwords [cmdName, B.pack (chatNameStr chatName), cryptoFileStr f]
cryptoFileStr CryptoFile {filePath, cryptoArgs} =
maybe "" (\(CFArgs key nonce) -> "key=" <> strEncode key <> " nonce=" <> strEncode nonce <> " ") cryptoArgs
<> encodeUtf8 (T.pack filePath)

232
src/Simplex/Chat/Remote/Protocol.hs
View File

@@ -8,7 +8,6 @@
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -Wno-ambiguous-fields #-}
module Simplex.Chat.Remote.Protocol where
@@ -35,12 +34,9 @@ import Data.Word (Word32)
import qualified Network.HTTP.Types as N
import qualified Network.HTTP2.Client as H
import Network.Transport.Internal (decodeWord32, encodeWord32)
import Simplex.Chat.Call (RcvCallInvitation (..))
import Simplex.Chat.Controller
import Simplex.Chat.Messages (AChat (..), Chat (..))
import Simplex.Chat.Remote.Transport
import Simplex.Chat.Remote.Types
import Simplex.Chat.Types (RemoteHostId, User (..), UserInfo (..), ServerCfg (..))
import Simplex.FileTransfer.Description (FileDigest (..))
import Simplex.Messaging.Agent.Client (agentDRG)
import qualified Simplex.Messaging.Crypto as C
@@ -109,232 +105,18 @@ closeRemoteHostClient RemoteHostClient {httpClient} = liftIO $ closeHTTP2Client
-- ** Commands
remoteSend :: RemoteHostId -> RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
remoteSend rhId c cmd =
remoteSend :: RemoteHostClient -> ByteString -> ExceptT RemoteProtocolError IO ChatResponse
remoteSend c cmd =
sendRemoteCommand' c Nothing RCSend {command = decodeUtf8 cmd} >>= \case
RRChatResponse cr -> pure $ enrichCRRemoteHostId cr rhId
RRChatResponse cr -> pure cr
r -> badResponse r
remoteRecv :: RemoteHostId -> RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
remoteRecv rhId c ms =
remoteRecv :: RemoteHostClient -> Int -> ExceptT RemoteProtocolError IO (Maybe ChatResponse)
remoteRecv c ms =
sendRemoteCommand' c Nothing RCRecv {wait = ms} >>= \case
RRChatEvent cr_ -> pure $ (`enrichCRRemoteHostId` rhId) <$> cr_
RRChatEvent cr_ -> pure cr_
r -> badResponse r
enrichCRRemoteHostId :: ChatResponse -> RemoteHostId -> ChatResponse
enrichCRRemoteHostId cr rhId = case cr of
CRActiveUser {user} -> CRActiveUser {user = enrichUser user}
CRUsersList {users} -> CRUsersList {users = map enrichUserInfo users}
CRChatStarted -> cr
CRChatRunning -> cr
CRChatStopped -> cr
CRChatSuspended -> cr
CRApiChats {user, chats} -> CRApiChats {user = enrichUser user, chats = map enrichAChat chats}
CRChats {chats} -> CRChats {chats = map enrichAChat chats}
CRApiChat {user, chat} -> CRApiChat {user = enrichUser user, chat = enrichAChat chat}
CRChatItems {user, chatName_, chatItems} -> CRChatItems {user = enrichUser user, chatName_, chatItems}
CRChatItemInfo {user, chatItem, chatItemInfo} -> CRChatItemInfo {user = enrichUser user, chatItem, chatItemInfo}
CRChatItemId user chatItemId_ -> CRChatItemId (enrichUser user) chatItemId_
CRApiParsedMarkdown {formattedText = _ft} -> cr
CRUserProtoServers {user, servers} -> CRUserProtoServers {user = enrichUser user, servers = enrichAUserProtoServers servers}
CRServerTestResult {user, testServer, testFailure} -> CRServerTestResult {user = enrichUser user, testServer, testFailure}
CRChatItemTTL {user, chatItemTTL} -> CRChatItemTTL {user = enrichUser user, chatItemTTL}
CRNetworkConfig {networkConfig = _nc} -> cr
CRContactInfo {user, contact, connectionStats_, customUserProfile} -> CRContactInfo {user = enrichUser user, contact, connectionStats_, customUserProfile}
CRGroupInfo {user, groupInfo, groupSummary} -> CRGroupInfo {user = enrichUser user, groupInfo, groupSummary}
CRGroupMemberInfo {user, groupInfo, member, connectionStats_} -> CRGroupMemberInfo {user = enrichUser user, groupInfo, member, connectionStats_}
CRContactSwitchStarted {user, contact, connectionStats} -> CRContactSwitchStarted {user = enrichUser user, contact, connectionStats}
CRGroupMemberSwitchStarted {user, groupInfo, member, connectionStats} -> CRGroupMemberSwitchStarted {user = enrichUser user, groupInfo, member, connectionStats}
CRContactSwitchAborted {user, contact, connectionStats} -> CRContactSwitchAborted {user = enrichUser user, contact, connectionStats}
CRGroupMemberSwitchAborted {user, groupInfo, member, connectionStats} -> CRGroupMemberSwitchAborted {user = enrichUser user, groupInfo, member, connectionStats}
CRContactSwitch {user, contact, switchProgress} -> CRContactSwitch {user = enrichUser user, contact, switchProgress}
CRGroupMemberSwitch {user, groupInfo, member, switchProgress} -> CRGroupMemberSwitch {user = enrichUser user, groupInfo, member, switchProgress}
CRContactRatchetSyncStarted {user, contact, connectionStats} -> CRContactRatchetSyncStarted {user = enrichUser user, contact, connectionStats}
CRGroupMemberRatchetSyncStarted {user, groupInfo, member, connectionStats} -> CRGroupMemberRatchetSyncStarted {user = enrichUser user, groupInfo, member, connectionStats}
CRContactRatchetSync {user, contact, ratchetSyncProgress} -> CRContactRatchetSync {user = enrichUser user, contact, ratchetSyncProgress}
CRGroupMemberRatchetSync {user, groupInfo, member, ratchetSyncProgress} -> CRGroupMemberRatchetSync {user = enrichUser user, groupInfo, member, ratchetSyncProgress}
CRContactVerificationReset {user, contact} -> CRContactVerificationReset {user = enrichUser user, contact}
CRGroupMemberVerificationReset {user, groupInfo, member} -> CRGroupMemberVerificationReset {user = enrichUser user, groupInfo, member}
CRContactCode {user, contact, connectionCode} -> CRContactCode {user = enrichUser user, contact, connectionCode}
CRGroupMemberCode {user, groupInfo, member, connectionCode} -> CRGroupMemberCode {user = enrichUser user, groupInfo, member, connectionCode}
CRConnectionVerified {user, verified, expectedCode} -> CRConnectionVerified {user = enrichUser user, verified, expectedCode}
CRNewChatItem {user, chatItem} -> CRNewChatItem {user = enrichUser user, chatItem}
CRChatItemStatusUpdated {user, chatItem} -> CRChatItemStatusUpdated {user = enrichUser user, chatItem}
CRChatItemUpdated {user, chatItem} -> CRChatItemUpdated {user = enrichUser user, chatItem}
CRChatItemNotChanged {user, chatItem} -> CRChatItemNotChanged {user = enrichUser user, chatItem}
CRChatItemReaction {user, added, reaction} -> CRChatItemReaction {user = enrichUser user, added, reaction}
CRChatItemDeleted {user, deletedChatItem, toChatItem, byUser, timed} -> CRChatItemDeleted {user = enrichUser user, deletedChatItem, toChatItem, byUser, timed}
CRChatItemDeletedNotFound {user, contact, sharedMsgId} -> CRChatItemDeletedNotFound {user = enrichUser user, contact, sharedMsgId}
CRBroadcastSent {user, msgContent, successes, failures, timestamp} -> CRBroadcastSent {user = enrichUser user, msgContent, successes, failures, timestamp}
CRMsgIntegrityError {user, msgError} -> CRMsgIntegrityError {user = enrichUser user, msgError}
CRCmdAccepted {corr = _corr} -> cr
CRCmdOk {user_} -> CRCmdOk {user_ = enrichUser <$> user_}
CRChatHelp {helpSection = _hs} -> cr
CRWelcome {user} -> CRWelcome {user = enrichUser user}
CRGroupCreated {user, groupInfo} -> CRGroupCreated {user = enrichUser user, groupInfo}
CRGroupMembers {user, group} -> CRGroupMembers {user = enrichUser user, group}
CRContactsList {user, contacts} -> CRContactsList {user = enrichUser user, contacts}
CRUserContactLink {user, contactLink} -> CRUserContactLink {user = enrichUser user, contactLink}
CRUserContactLinkUpdated {user, contactLink} -> CRUserContactLinkUpdated {user = enrichUser user, contactLink}
CRContactRequestRejected {user, contactRequest} -> CRContactRequestRejected {user = enrichUser user, contactRequest}
CRUserAcceptedGroupSent {user, groupInfo, hostContact} -> CRUserAcceptedGroupSent {user = enrichUser user, groupInfo, hostContact}
CRGroupLinkConnecting {user, groupInfo, hostMember} -> CRGroupLinkConnecting {user = enrichUser user, groupInfo, hostMember}
CRUserDeletedMember {user, groupInfo, member} -> CRUserDeletedMember {user = enrichUser user, groupInfo, member}
CRGroupsList {user, groups} -> CRGroupsList {user = enrichUser user, groups}
CRSentGroupInvitation {user, groupInfo, contact, member} -> CRSentGroupInvitation {user = enrichUser user, groupInfo, contact, member}
CRFileTransferStatus user ftStatus -> CRFileTransferStatus (enrichUser user) ftStatus
CRFileTransferStatusXFTP user chatItem -> CRFileTransferStatusXFTP (enrichUser user) chatItem
CRUserProfile {user, profile} -> CRUserProfile {user = enrichUser user, profile}
CRUserProfileNoChange {user} -> CRUserProfileNoChange {user = enrichUser user}
CRUserPrivacy {user, updatedUser} -> CRUserPrivacy {user = enrichUser user, updatedUser = enrichUser updatedUser}
CRVersionInfo {versionInfo = _v, chatMigrations = _cm, agentMigrations = _am} -> cr
CRInvitation {user, connReqInvitation, connection} -> CRInvitation {user = enrichUser user, connReqInvitation, connection}
CRConnectionIncognitoUpdated {user, toConnection} -> CRConnectionIncognitoUpdated {user = enrichUser user, toConnection}
CRConnectionPlan {user, connectionPlan} -> CRConnectionPlan {user = enrichUser user, connectionPlan}
CRSentConfirmation {user} -> CRSentConfirmation {user = enrichUser user}
CRSentInvitation {user, customUserProfile} -> CRSentInvitation {user = enrichUser user, customUserProfile}
CRSentInvitationToContact {user, contact, customUserProfile} -> CRSentInvitationToContact {user = enrichUser user, contact, customUserProfile}
CRContactUpdated {user, fromContact, toContact} -> CRContactUpdated {user = enrichUser user, fromContact, toContact}
CRGroupMemberUpdated {user, groupInfo, fromMember, toMember} -> CRGroupMemberUpdated {user = enrichUser user, groupInfo, fromMember, toMember}
CRContactsMerged {user, intoContact, mergedContact, updatedContact} -> CRContactsMerged {user = enrichUser user, intoContact, mergedContact, updatedContact}
CRContactDeleted {user, contact} -> CRContactDeleted {user = enrichUser user, contact}
CRContactDeletedByContact {user, contact} -> CRContactDeletedByContact {user = enrichUser user, contact}
CRChatCleared {user, chatInfo} -> CRChatCleared {user = enrichUser user, chatInfo}
CRUserContactLinkCreated {user, connReqContact} -> CRUserContactLinkCreated {user = enrichUser user, connReqContact}
CRUserContactLinkDeleted {user} -> CRUserContactLinkDeleted {user = enrichUser user}
CRReceivedContactRequest {user, contactRequest} -> CRReceivedContactRequest {user = enrichUser user, contactRequest}
CRAcceptingContactRequest {user, contact} -> CRAcceptingContactRequest {user = enrichUser user, contact}
CRContactAlreadyExists {user, contact} -> CRContactAlreadyExists {user = enrichUser user, contact}
CRContactRequestAlreadyAccepted {user, contact} -> CRContactRequestAlreadyAccepted {user = enrichUser user, contact}
CRLeftMemberUser {user, groupInfo} -> CRLeftMemberUser {user = enrichUser user, groupInfo}
CRGroupDeletedUser {user, groupInfo} -> CRGroupDeletedUser {user = enrichUser user, groupInfo}
CRRcvFileDescrReady {user, chatItem} -> CRRcvFileDescrReady {user = enrichUser user, chatItem}
CRRcvFileAccepted {user, chatItem} -> CRRcvFileAccepted {user = enrichUser user, chatItem}
CRRcvFileAcceptedSndCancelled {user, rcvFileTransfer} -> CRRcvFileAcceptedSndCancelled {user = enrichUser user, rcvFileTransfer}
CRRcvFileDescrNotReady {user, chatItem} -> CRRcvFileDescrNotReady {user = enrichUser user, chatItem}
CRRcvFileStart {user, chatItem} -> CRRcvFileStart {user = enrichUser user, chatItem}
CRRcvFileProgressXFTP {user, chatItem, receivedSize, totalSize} -> CRRcvFileProgressXFTP {user = enrichUser user, chatItem, receivedSize, totalSize}
CRRcvFileComplete {user, chatItem} -> CRRcvFileComplete {user = enrichUser user, chatItem}
CRRcvFileCancelled {user, chatItem, rcvFileTransfer} -> CRRcvFileCancelled {user = enrichUser user, chatItem, rcvFileTransfer}
CRRcvFileSndCancelled {user, chatItem, rcvFileTransfer} -> CRRcvFileSndCancelled {user = enrichUser user, chatItem, rcvFileTransfer}
CRRcvFileError {user, chatItem, agentError} -> CRRcvFileError {user = enrichUser user, chatItem, agentError}
CRSndFileStart {user, chatItem, sndFileTransfer} -> CRSndFileStart {user = enrichUser user, chatItem, sndFileTransfer}
CRSndFileComplete {user, chatItem, sndFileTransfer} -> CRSndFileComplete {user = enrichUser user, chatItem, sndFileTransfer}
CRSndFileRcvCancelled {user, chatItem, sndFileTransfer} -> CRSndFileRcvCancelled {user = enrichUser user, chatItem, sndFileTransfer}
CRSndFileCancelled {user, chatItem, fileTransferMeta, sndFileTransfers} -> CRSndFileCancelled {user = enrichUser user, chatItem, fileTransferMeta, sndFileTransfers}
CRSndFileStartXFTP {user, chatItem, fileTransferMeta} -> CRSndFileStartXFTP {user = enrichUser user, chatItem, fileTransferMeta}
CRSndFileProgressXFTP {user, chatItem, fileTransferMeta, sentSize, totalSize} -> CRSndFileProgressXFTP {user = enrichUser user, chatItem, fileTransferMeta, sentSize, totalSize}
CRSndFileCompleteXFTP {user, chatItem, fileTransferMeta} -> CRSndFileCompleteXFTP {user = enrichUser user, chatItem, fileTransferMeta}
CRSndFileCancelledXFTP {user, chatItem, fileTransferMeta} -> CRSndFileCancelledXFTP {user = enrichUser user, chatItem, fileTransferMeta}
CRSndFileError {user, chatItem} -> CRSndFileError {user = enrichUser user, chatItem}
CRUserProfileUpdated {user, fromProfile, toProfile, updateSummary} -> CRUserProfileUpdated {user = enrichUser user, fromProfile, toProfile, updateSummary}
CRUserProfileImage {user, profile} -> CRUserProfileImage {user = enrichUser user, profile}
CRContactAliasUpdated {user, toContact} -> CRContactAliasUpdated {user = enrichUser user, toContact}
CRConnectionAliasUpdated {user, toConnection} -> CRConnectionAliasUpdated {user = enrichUser user, toConnection}
CRContactPrefsUpdated {user, fromContact, toContact} -> CRContactPrefsUpdated {user = enrichUser user, fromContact, toContact}
CRContactConnecting {user, contact} -> CRContactConnecting {user = enrichUser user, contact}
CRContactConnected {user, contact, userCustomProfile} -> CRContactConnected {user = enrichUser user, contact, userCustomProfile}
CRContactAnotherClient {user, contact} -> CRContactAnotherClient {user = enrichUser user, contact}
CRSubscriptionEnd {user, connectionEntity} -> CRSubscriptionEnd {user = enrichUser user, connectionEntity}
CRContactsDisconnected {server = _srv, contactRefs = _cr} -> cr
CRContactsSubscribed {server = _srv, contactRefs = _cr} -> cr
CRContactSubError {user, contact, chatError} -> CRContactSubError {user = enrichUser user, contact, chatError}
CRContactSubSummary {user, contactSubscriptions} -> CRContactSubSummary {user = enrichUser user, contactSubscriptions}
CRUserContactSubSummary {user, userContactSubscriptions} -> CRUserContactSubSummary {user = enrichUser user, userContactSubscriptions}
CRNetworkStatus {networkStatus = _ns, connections = _cns} -> cr
CRNetworkStatuses {user_, networkStatuses} -> CRNetworkStatuses {user_ = enrichUser <$> user_, networkStatuses}
CRHostConnected {protocol = _p, transportHost = _th} -> cr
CRHostDisconnected {protocol = _p, transportHost = _th} -> cr
CRGroupInvitation {user, groupInfo} -> CRGroupInvitation {user = enrichUser user, groupInfo}
CRReceivedGroupInvitation {user, groupInfo, contact, fromMemberRole, memberRole} -> CRReceivedGroupInvitation {user = enrichUser user, groupInfo, contact, fromMemberRole, memberRole}
CRUserJoinedGroup {user, groupInfo, hostMember} -> CRUserJoinedGroup {user = enrichUser user, groupInfo, hostMember}
CRJoinedGroupMember {user, groupInfo, member} -> CRJoinedGroupMember {user = enrichUser user, groupInfo, member}
CRJoinedGroupMemberConnecting {user, groupInfo, hostMember, member} -> CRJoinedGroupMemberConnecting {user = enrichUser user, groupInfo, hostMember, member}
CRMemberRole {user, groupInfo, byMember, member, fromRole, toRole} -> CRMemberRole {user = enrichUser user, groupInfo, byMember, member, fromRole, toRole}
CRMemberRoleUser {user, groupInfo, member, fromRole, toRole} -> CRMemberRoleUser {user = enrichUser user, groupInfo, member, fromRole, toRole}
CRConnectedToGroupMember {user, groupInfo, member, memberContact} -> CRConnectedToGroupMember {user = enrichUser user, groupInfo, member, memberContact}
CRDeletedMember {user, groupInfo, byMember, deletedMember} -> CRDeletedMember {user = enrichUser user, groupInfo, byMember, deletedMember}
CRDeletedMemberUser {user, groupInfo, member} -> CRDeletedMemberUser {user = enrichUser user, groupInfo, member}
CRLeftMember {user, groupInfo, member} -> CRLeftMember {user = enrichUser user, groupInfo, member}
CRGroupEmpty {user, groupInfo} -> CRGroupEmpty {user = enrichUser user, groupInfo}
CRGroupRemoved {user, groupInfo} -> CRGroupRemoved {user = enrichUser user, groupInfo}
CRGroupDeleted {user, groupInfo, member} -> CRGroupDeleted {user = enrichUser user, groupInfo, member}
CRGroupUpdated {user, fromGroup, toGroup, member_} -> CRGroupUpdated {user = enrichUser user, fromGroup, toGroup, member_}
CRGroupProfile {user, groupInfo} -> CRGroupProfile {user = enrichUser user, groupInfo}
CRGroupDescription {user, groupInfo} -> CRGroupDescription {user = enrichUser user, groupInfo}
CRGroupLinkCreated {user, groupInfo, connReqContact, memberRole} -> CRGroupLinkCreated {user = enrichUser user, groupInfo, connReqContact, memberRole}
CRGroupLink {user, groupInfo, connReqContact, memberRole} -> CRGroupLink {user = enrichUser user, groupInfo, connReqContact, memberRole}
CRGroupLinkDeleted {user, groupInfo} -> CRGroupLinkDeleted {user = enrichUser user, groupInfo}
CRAcceptingGroupJoinRequest {user, groupInfo, contact} -> CRAcceptingGroupJoinRequest {user = enrichUser user, groupInfo, contact}
CRAcceptingGroupJoinRequestMember {user, groupInfo, member} -> CRAcceptingGroupJoinRequestMember {user = enrichUser user, groupInfo, member}
CRNoMemberContactCreating {user, groupInfo, member} -> CRNoMemberContactCreating {user = enrichUser user, groupInfo, member}
CRNewMemberContact {user, contact, groupInfo, member} -> CRNewMemberContact {user = enrichUser user, contact, groupInfo, member}
CRNewMemberContactSentInv {user, contact, groupInfo, member} -> CRNewMemberContactSentInv {user = enrichUser user, contact, groupInfo, member}
CRNewMemberContactReceivedInv {user, contact, groupInfo, member} -> CRNewMemberContactReceivedInv {user = enrichUser user, contact, groupInfo, member}
CRContactAndMemberAssociated {user, contact, groupInfo, member, updatedContact} -> CRContactAndMemberAssociated {user = enrichUser user, contact, groupInfo, member, updatedContact}
CRMemberSubError {user, groupInfo, member, chatError} -> CRMemberSubError {user = enrichUser user, groupInfo, member, chatError}
CRMemberSubSummary {user, memberSubscriptions} -> CRMemberSubSummary {user = enrichUser user, memberSubscriptions}
CRGroupSubscribed {user, groupInfo} -> CRGroupSubscribed {user = enrichUser user, groupInfo}
CRPendingSubSummary {user, pendingSubscriptions} -> CRPendingSubSummary {user = enrichUser user, pendingSubscriptions}
CRSndFileSubError {user, sndFileTransfer, chatError} -> CRSndFileSubError {user = enrichUser user, sndFileTransfer, chatError}
CRRcvFileSubError {user, rcvFileTransfer, chatError} -> CRRcvFileSubError {user = enrichUser user, rcvFileTransfer, chatError}
CRCallInvitation {callInvitation} -> CRCallInvitation {callInvitation = enrichRcvCallInvitation callInvitation}
CRCallOffer {user, contact, callType, offer, sharedKey, askConfirmation} -> CRCallOffer {user = enrichUser user, contact, callType, offer, sharedKey, askConfirmation}
CRCallAnswer {user, contact, answer} -> CRCallAnswer {user = enrichUser user, contact, answer}
CRCallExtraInfo {user, contact, extraInfo} -> CRCallExtraInfo {user = enrichUser user, contact, extraInfo}
CRCallEnded {user, contact} -> CRCallEnded {user = enrichUser user, contact}
CRCallInvitations {callInvitations} -> CRCallInvitations {callInvitations = map enrichRcvCallInvitation callInvitations}
CRUserContactLinkSubscribed -> cr
CRUserContactLinkSubError {chatError = _ce} -> cr
CRNtfTokenStatus {status = _s} -> cr
CRNtfToken {token = _t, status = _s, ntfMode = _nm} -> cr
CRNtfMessages {user_, connEntity, msgTs, ntfMessages} -> CRNtfMessages {user_ = enrichUser <$> user_, connEntity, msgTs, ntfMessages}
CRNewContactConnection {user, connection} -> CRNewContactConnection {user = enrichUser user, connection}
CRContactConnectionDeleted {user, connection} -> CRContactConnectionDeleted {user = enrichUser user, connection}
CRRemoteHostList {remoteHosts = _rh} -> cr
CRCurrentRemoteHost {remoteHost_ = _rh} -> cr
CRRemoteHostStarted {remoteHost_ = _rh, invitation = _i} -> cr
CRRemoteHostSessionCode {remoteHost_ = _rh, sessionCode = _sc} -> cr
CRNewRemoteHost {remoteHost = _rh} -> cr
CRRemoteHostConnected {remoteHost = _rh} -> cr
CRRemoteHostStopped {remoteHostId_ = _rh} -> cr
CRRemoteFileStored {remoteHostId = _rhId, remoteFileSource = _rfs} -> cr
CRRemoteCtrlList {remoteCtrls = _rc} -> cr
CRRemoteCtrlFound {remoteCtrl = _rc} -> cr
CRRemoteCtrlConnecting {remoteCtrl_ = _rc, ctrlAppInfo = _cai, appVersion = _av} -> cr
CRRemoteCtrlSessionCode {remoteCtrl_ = _rc, sessionCode = _sc} -> cr
CRRemoteCtrlConnected {remoteCtrl = _rc} -> cr
CRRemoteCtrlStopped -> cr
CRSQLResult {rows = _r} -> cr
CRSlowSQLQueries {chatQueries = _cq, agentQueries = _aq} -> cr
CRDebugLocks {chatLockName = _cl, agentLocks = _al} -> cr
CRAgentStats {agentStats = _as} -> cr
CRAgentSubs {activeSubs = _as, pendingSubs = _ps, removedSubs = _rs} -> cr
CRAgentSubsDetails {agentSubs = _as} -> cr
CRConnectionDisabled {connectionEntity = _ce} -> cr
CRAgentRcvQueueDeleted {agentConnId = _acId, server = _srv, agentQueueId = _aqId, agentError_ = _ae} -> cr
CRAgentConnDeleted {agentConnId = _acId} -> cr
CRAgentUserDeleted {agentUserId = _auId} -> cr
CRMessageError {user, severity, errorMessage} -> CRMessageError {user = enrichUser user, severity, errorMessage}
CRChatCmdError {user_, chatError} -> CRChatCmdError {user_ = enrichUser <$> user_, chatError}
CRChatError {user_, chatError} -> CRChatError {user_ = enrichUser <$> user_, chatError}
CRArchiveImported {archiveErrors = _ae} -> cr
CRTimedAction {action = _a, durationMilliseconds = _dm} -> cr
where
enrichUser :: User -> User
enrichUser u = u {remoteHostId = Just rhId}
enrichUserInfo :: UserInfo -> UserInfo
enrichUserInfo uInfo@UserInfo {user} = uInfo {user = enrichUser user}
enrichAChat :: AChat -> AChat
enrichAChat (AChat cType chat) = AChat cType chat {remoteHostId = Just rhId}
enrichServerCfg :: ServerCfg p -> ServerCfg p
enrichServerCfg cfg = cfg {remoteHostId = Just rhId}
enrichAUserProtoServers :: AUserProtoServers -> AUserProtoServers
enrichAUserProtoServers (AUPS ups@UserProtoServers {protoServers}) = AUPS ups {protoServers = fmap enrichServerCfg protoServers}
enrichRcvCallInvitation :: RcvCallInvitation -> RcvCallInvitation
enrichRcvCallInvitation rci = rci {remoteHostId = Just rhId}
remoteStoreFile :: RemoteHostClient -> FilePath -> FilePath -> ExceptT RemoteProtocolError IO FilePath
remoteStoreFile c localPath fileName = do
(fileSize, fileDigest) <- getFileInfo localPath
@@ -358,7 +140,7 @@ sendRemoteCommand' c attachment_ rc = snd <$> sendRemoteCommand c attachment_ rc
sendRemoteCommand :: RemoteHostClient -> Maybe (Handle, Word32) -> RemoteCommand -> ExceptT RemoteProtocolError IO (Int -> IO ByteString, RemoteResponse)
sendRemoteCommand RemoteHostClient {httpClient, hostEncoding, encryption} file_ cmd = do
encFile_ <- mapM (prepareEncryptedFile encryption) file_
encFile_ <- mapM (prepareEncryptedFile encryption) file_
req <- httpRequest encFile_ <$> encryptEncodeHTTP2Body encryption (J.encode cmd)
HTTP2Response {response, respBody} <- liftEitherError (RPEHTTP2 . tshow) $ sendRequestDirect httpClient req Nothing
(header, getNext) <- parseDecryptHTTP2Body encryption response respBody

4
src/Simplex/Chat/Remote/Types.hs
View File

@@ -19,7 +19,7 @@ import Data.ByteString (ByteString)
import Data.Int (Int64)
import Data.Text (Text)
import Simplex.Chat.Remote.AppVersion
import Simplex.Chat.Types (verificationCode, RemoteHostId)
import Simplex.Chat.Types (verificationCode)
import qualified Simplex.Messaging.Crypto as C
import Simplex.Messaging.Crypto.SNTRUP761 (KEMHybridSecret)
import Simplex.Messaging.Parsers (defaultJSON, dropPrefix, enumJSON, sumTypeJSON)
@@ -118,6 +118,8 @@ data RemoteProtocolError
| RPEException {someException :: Text}
deriving (Show, Exception)
type RemoteHostId = Int64
data RHKey = RHNew | RHId {remoteHostId :: RemoteHostId}
deriving (Eq, Ord, Show)

20
src/Simplex/Chat/Store/Messages.hs
View File

@@ -572,7 +572,7 @@ getDirectChatPreviews_ db user@User {userId} = do
let contact = toContact user $ contactRow :. connRow
ci_ = toDirectChatItemList currentTs ciRow_
stats = toChatStats statsRow
in AChat SCTDirect $ Chat Nothing (DirectChat contact) ci_ stats
in AChat SCTDirect $ Chat (DirectChat contact) ci_ stats
getGroupChatPreviews_ :: DB.Connection -> User -> IO [AChat]
getGroupChatPreviews_ db User {userId, userContactId} = do
@@ -645,7 +645,7 @@ getGroupChatPreviews_ db User {userId, userContactId} = do
let groupInfo = toGroupInfo userContactId groupInfoRow
ci_ = toGroupChatItemList currentTs userContactId ciRow_
stats = toChatStats statsRow
in AChat SCTGroup $ Chat Nothing (GroupChat groupInfo) ci_ stats
in AChat SCTGroup $ Chat (GroupChat groupInfo) ci_ stats
getContactRequestChatPreviews_ :: DB.Connection -> User -> IO [AChat]
getContactRequestChatPreviews_ db User {userId} =
@@ -669,7 +669,7 @@ getContactRequestChatPreviews_ db User {userId} =
toContactRequestChatPreview cReqRow =
let cReq = toContactRequest cReqRow
stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
in AChat SCTContactRequest $ Chat Nothing (ContactRequest cReq) [] stats
in AChat SCTContactRequest $ Chat (ContactRequest cReq) [] stats
getContactConnectionChatPreviews_ :: DB.Connection -> User -> Bool -> IO [AChat]
getContactConnectionChatPreviews_ _ _ False = pure []
@@ -688,7 +688,7 @@ getContactConnectionChatPreviews_ db User {userId} _ =
toContactConnectionChatPreview connRow =
let conn = toPendingContactConnection connRow
stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
in AChat SCTContactConnection $ Chat Nothing (ContactConnection conn) [] stats
in AChat SCTContactConnection $ Chat (ContactConnection conn) [] stats
getDirectChat :: DB.Connection -> User -> Int64 -> ChatPagination -> Maybe String -> ExceptT StoreError IO (Chat 'CTDirect)
getDirectChat db user contactId pagination search_ = do
@@ -703,7 +703,7 @@ getDirectChatLast_ :: DB.Connection -> User -> Contact -> Int -> String -> Excep
getDirectChatLast_ db user ct@Contact {contactId} count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- getDirectChatItemsLast db user contactId count search
pure $ Chat Nothing (DirectChat ct) (reverse chatItems) stats
pure $ Chat (DirectChat ct) (reverse chatItems) stats
-- the last items in reverse order (the last item in the conversation is the first in the returned list)
getDirectChatItemsLast :: DB.Connection -> User -> ContactId -> Int -> String -> ExceptT StoreError IO [CChatItem 'CTDirect]
@@ -733,7 +733,7 @@ getDirectChatAfter_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int ->
getDirectChatAfter_ db User {userId} ct@Contact {contactId} afterChatItemId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- ExceptT getDirectChatItemsAfter_
pure $ Chat Nothing (DirectChat ct) chatItems stats
pure $ Chat (DirectChat ct) chatItems stats
where
getDirectChatItemsAfter_ :: IO (Either StoreError [CChatItem 'CTDirect])
getDirectChatItemsAfter_ = do
@@ -763,7 +763,7 @@ getDirectChatBefore_ :: DB.Connection -> User -> Contact -> ChatItemId -> Int ->
getDirectChatBefore_ db User {userId} ct@Contact {contactId} beforeChatItemId count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItems <- ExceptT getDirectChatItemsBefore_
pure $ Chat Nothing (DirectChat ct) (reverse chatItems) stats
pure $ Chat (DirectChat ct) (reverse chatItems) stats
where
getDirectChatItemsBefore_ :: IO (Either StoreError [CChatItem 'CTDirect])
getDirectChatItemsBefore_ = do
@@ -803,7 +803,7 @@ getGroupChatLast_ db user@User {userId} g@GroupInfo {groupId} count search = do
let stats = ChatStats {unreadCount = 0, minUnreadItemId = 0, unreadChat = False}
chatItemIds <- liftIO getGroupChatItemIdsLast_
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat Nothing (GroupChat g) (reverse chatItems) stats
pure $ Chat (GroupChat g) (reverse chatItems) stats
where
getGroupChatItemIdsLast_ :: IO [ChatItemId]
getGroupChatItemIdsLast_ =
@@ -841,7 +841,7 @@ getGroupChatAfter_ db user@User {userId} g@GroupInfo {groupId} afterChatItemId c
afterChatItem <- getGroupChatItem db user groupId afterChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsAfter_ (chatItemTs afterChatItem)
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat Nothing (GroupChat g) chatItems stats
pure $ Chat (GroupChat g) chatItems stats
where
getGroupChatItemIdsAfter_ :: UTCTime -> IO [ChatItemId]
getGroupChatItemIdsAfter_ afterChatItemTs =
@@ -864,7 +864,7 @@ getGroupChatBefore_ db user@User {userId} g@GroupInfo {groupId} beforeChatItemId
beforeChatItem <- getGroupChatItem db user groupId beforeChatItemId
chatItemIds <- liftIO $ getGroupChatItemIdsBefore_ (chatItemTs beforeChatItem)
chatItems <- mapM (getGroupCIWithReactions db user g) chatItemIds
pure $ Chat Nothing (GroupChat g) (reverse chatItems) stats
pure $ Chat (GroupChat g) (reverse chatItems) stats
where
getGroupChatItemIdsBefore_ :: UTCTime -> IO [ChatItemId]
getGroupChatItemIdsBefore_ beforeChatItemTs =

4
src/Simplex/Chat/Store/Profiles.hs
View File

@@ -504,7 +504,7 @@ getProtocolServers db User {userId} =
toServerCfg :: (NonEmpty TransportHost, String, C.KeyHash, Maybe Text, Bool, Maybe Bool, Bool) -> ServerCfg p
toServerCfg (host, port, keyHash, auth_, preset, tested, enabled) =
let server = ProtoServerWithAuth (ProtocolServer protocol host port keyHash) (BasicAuth . encodeUtf8 <$> auth_)
in ServerCfg {remoteHostId = Nothing, server, preset, tested, enabled}
in ServerCfg {server, preset, tested, enabled}
overwriteProtocolServers :: forall p. ProtocolTypeI p => DB.Connection -> User -> [ServerCfg p] -> ExceptT StoreError IO ()
overwriteProtocolServers db User {userId} servers =
@@ -555,7 +555,7 @@ getCalls db =
|]
where
toCall :: (ContactId, CallId, ChatItemId, CallState, UTCTime) -> Call
toCall (contactId, callId, chatItemId, callState, callTs) = Call {remoteHostId = Nothing, contactId, callId, chatItemId, callState, callTs}
toCall (contactId, callId, chatItemId, callState, callTs) = Call {contactId, callId, chatItemId, callState, callTs}
createCommand :: DB.Connection -> User -> Maybe Int64 -> CommandFunction -> IO CommandId
createCommand db User {userId} connId commandFunction = do

1
src/Simplex/Chat/Store/Remote.hs
View File

@@ -18,7 +18,6 @@ import qualified Simplex.Messaging.Agent.Store.SQLite.DB as DB
import qualified Simplex.Messaging.Crypto as C
import Simplex.RemoteControl.Types
import UnliftIO
import Simplex.Chat.Types (RemoteHostId)
insertRemoteHost :: DB.Connection -> Text -> FilePath -> RCHostPairing -> ExceptT StoreError IO RemoteHostId
insertRemoteHost db hostDeviceName storePath RCHostPairing {caKey, caCert, idPrivKey, knownHost = kh_} = do

2
src/Simplex/Chat/Store/Shared.hs
View File

@@ -316,7 +316,7 @@ userQuery =
toUser :: (UserId, UserId, ContactId, ProfileId, Bool, ContactName, Text, Maybe ImageData, Maybe ConnReqContact, Maybe Preferences) :. (Bool, Bool, Bool, Maybe B64UrlByteString, Maybe B64UrlByteString) -> User
toUser ((userId, auId, userContactId, profileId, activeUser, displayName, fullName, image, contactLink, userPreferences) :. (showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash_, viewPwdSalt_)) =
User {remoteHostId = Nothing, userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash}
User {userId, agentUserId = AgentUserId auId, userContactId, localDisplayName = displayName, profile, activeUser, fullPreferences, showNtfs, sendRcptsContacts, sendRcptsSmallGroups, viewPwdHash}
where
profile = LocalProfile {profileId, displayName, fullName, image, contactLink, preferences = userPreferences, localAlias = ""}
fullPreferences = mergePreferences Nothing userPreferences

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

@@ -26,6 +26,7 @@ import Simplex.Chat.Messages
import Simplex.Chat.Messages.CIContent (CIContent(..), SMsgDirection (..))
import Simplex.Chat.Options
import Simplex.Chat.Protocol (MsgContent (..), msgContentText)
import Simplex.Chat.Remote.Types (RemoteHostId)
import Simplex.Chat.Styled
import Simplex.Chat.Terminal.Notification (Notification (..), initializeNotifications)
import Simplex.Chat.Types

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

@@ -100,14 +100,11 @@ instance FromField AgentUserId where fromField f = AgentUserId <$> fromField f
instance ToField AgentUserId where toField (AgentUserId uId) = toField uId
type RemoteHostId = Int64
aUserId :: User -> UserId
aUserId User {agentUserId = AgentUserId uId} = uId
data User = User
{ remoteHostId :: Maybe RemoteHostId,
userId :: UserId,
{ userId :: UserId,
agentUserId :: AgentUserId,
userContactId :: ContactId,
localDisplayName :: ContactName,
@@ -1524,8 +1521,7 @@ data XGrpMemIntroCont = XGrpMemIntroCont
deriving (Show)
data ServerCfg p = ServerCfg
{ remoteHostId :: Maybe RemoteHostId,
server :: ProtoServerWithAuth p,
{ server :: ProtoServerWithAuth p,
preset :: Bool,
tested :: Maybe Bool,
enabled :: Bool

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

@@ -387,10 +387,10 @@ responseToView hu@(currentRH, user_) ChatConfig {logLevel, showReactions, showRe
testViewChats chats = [sShow $ map toChatView chats]
where
toChatView :: AChat -> (Text, Text, Maybe ConnStatus)
toChatView (AChat _ (Chat _ (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, connStatus <$> activeConn)
toChatView (AChat _ (Chat _ (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing)
toChatView (AChat _ (Chat _ (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing)
toChatView (AChat _ (Chat _ (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus)
toChatView (AChat _ (Chat (DirectChat Contact {localDisplayName, activeConn}) items _)) = ("@" <> localDisplayName, toCIPreview items Nothing, connStatus <$> activeConn)
toChatView (AChat _ (Chat (GroupChat GroupInfo {membership, localDisplayName}) items _)) = ("#" <> localDisplayName, toCIPreview items (Just membership), Nothing)
toChatView (AChat _ (Chat (ContactRequest UserContactRequest {localDisplayName}) items _)) = ("<@" <> localDisplayName, toCIPreview items Nothing, Nothing)
toChatView (AChat _ (Chat (ContactConnection PendingContactConnection {pccConnId, pccConnStatus}) items _)) = (":" <> T.pack (show pccConnId), toCIPreview items Nothing, Just pccConnStatus)
toCIPreview :: [CChatItem c] -> Maybe GroupMember -> Text
toCIPreview (ci : _) membership_ = testViewItem ci membership_
toCIPreview _ _ = ""
@@ -496,7 +496,7 @@ viewHostEvent p h = map toUpper (B.unpack $ strEncode p) <> " host " <> B.unpack
viewChats :: CurrentTime -> TimeZone -> [AChat] -> [StyledString]
viewChats ts tz = concatMap chatPreview . reverse
where
chatPreview (AChat _ (Chat _ chat items _)) = case items of
chatPreview (AChat _ (Chat chat items _)) = case items of
CChatItem _ ci : _ -> case viewChatItem chat ci True ts tz of
s : _ -> [let s' = sTake 120 s in if sLength s' < sLength s then s' <> "..." else s']
_ -> chatName