Permanent user addresses (aka contact links) (#139)

* update for ConectionMode parameters

* update with CONF notification and different ConnectionRequest types

* high level flow for contact requests, add x.con to chat protocol

* store functions for user contact links and contact requests

* contact links work

* subscribe to user contact link connection

* subscribe to user contact address: messages

* send rejectContact to the agents when rejected in chat

* user contact link (address) test

* Update src/Simplex/Chat/View.hs

* Update tests/ChatTests.hs

* user address help, fix tests

* delete connection requests when contact link deleted

Co-authored-by: Efim Poberezkin <8711996+efim-poberezkin@users.noreply.github.com>
This commit is contained in:
Evgeny Poberezkin
2021-12-08 13:09:51 +00:00
committed by GitHub
parent d279c144a6
commit 177c007edc
9 changed files with 631 additions and 124 deletions
+24 -10
View File
@@ -4,6 +4,7 @@ module Simplex.Chat.Help
( chatHelpInfo,
filesHelpInfo,
groupsHelpInfo,
myAddressHelpInfo,
markdownInfo,
)
where
@@ -34,7 +35,7 @@ chatHelpInfo =
"Follow these steps to set up a connection:",
"",
green "Step 1: " <> highlight "/connect" <> " - Alice adds a contact.",
indent <> "Alice should send the invitation printed by the /add command",
indent <> "Alice should send the one-time invitation printed by the /connect command",
indent <> "to her contact, Bob, out-of-band, via any trusted channel.",
"",
green "Step 2: " <> highlight "/connect <invitation>" <> " - Bob accepts the invitation.",
@@ -45,23 +46,20 @@ chatHelpInfo =
indent <> highlight "@bob Hello, Bob!" <> " - Alice messages Bob (assuming Bob has display name 'bob').",
indent <> highlight "@alice Hey, Alice!" <> " - Bob replies to Alice.",
"",
green "To send file:",
indent <> highlight "/file bob ./photo.jpg" <> " - Alice sends file to Bob",
indent <> "File commands: " <> highlight "/help files",
green "Send file: " <> highlight "/file bob ./photo.jpg" <> " (see /help files)",
"",
green "To create group:",
indent <> highlight "/group team" <> " - create group #team",
indent <> "Group commands: " <> highlight "/help groups",
green "Create group: " <> highlight "/group team" <> " (see /help groups)",
"",
green "Create your address: " <> highlight "/address" <> " (see /help address)",
"",
green "Other commands:",
indent <> highlight "/profile " <> " - show user profile",
indent <> highlight "/profile <name> [<full_name>]" <> " - update user profile",
indent <> highlight "/profile " <> " - show / update user profile",
indent <> highlight "/delete <contact>" <> " - delete contact and all messages with them",
indent <> highlight "/markdown " <> " - show supported markdown syntax",
indent <> highlight "/version " <> " - show SimpleX Chat version",
indent <> highlight "/quit " <> " - quit chat",
"",
"The commands may be abbreviated to a single letter: " <> listHighlight ["/c", "/f", "/g", "/p", "/h"] <> ", etc."
"The commands may be abbreviated: " <> listHighlight ["/c", "/f", "/g", "/p", "/ad"] <> ", etc."
]
filesHelpInfo :: [StyledString]
@@ -95,6 +93,22 @@ groupsHelpInfo =
"The commands may be abbreviated: " <> listHighlight ["/g", "/a", "/j", "/rm", "/l", "/d", "/ms"]
]
myAddressHelpInfo :: [StyledString]
myAddressHelpInfo =
map
styleMarkdown
[ green "Your contact address commands:",
indent <> highlight "/address " <> " - create your address",
indent <> highlight "/delete_address" <> " - delete your address (accepted contacts will remain connected)",
indent <> highlight "/show_address " <> " - show your address",
indent <> highlight "/accept <name> " <> " - accept contact request",
indent <> highlight "/reject <name> " <> " - reject contact request",
"",
"Please note: you can receive spam contact requests, but it's safe to delete the address!",
"",
"The commands may be abbreviated: " <> listHighlight ["/ad", "/da", "/sa", "/ac", "/rc"]
]
markdownInfo :: [StyledString]
markdownInfo =
map
+46 -13
View File
@@ -11,7 +11,7 @@
module Simplex.Chat.Protocol where
import Control.Applicative (optional)
import Control.Monad ((<=<))
import Control.Monad ((<=<), (>=>))
import Data.Aeson (FromJSON, ToJSON)
import qualified Data.Aeson as J
import Data.Attoparsec.ByteString.Char8 (Parser)
@@ -21,7 +21,7 @@ import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Int (Int64)
import Data.List (find)
import Data.List (find, findIndex)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Encoding (encodeUtf8)
@@ -38,6 +38,7 @@ data ChatDirection (p :: AParty) where
SentGroupMessage :: GroupName -> ChatDirection 'Client
SndFileConnection :: Connection -> SndFileTransfer -> ChatDirection 'Agent
RcvFileConnection :: Connection -> RcvFileTransfer -> ChatDirection 'Agent
UserContactConnection :: Connection -> UserContact -> ChatDirection 'Agent
deriving instance Eq (ChatDirection p)
@@ -49,12 +50,14 @@ fromConnection = \case
ReceivedGroupMessage conn _ _ -> conn
SndFileConnection conn _ -> conn
RcvFileConnection conn _ -> conn
UserContactConnection conn _ -> conn
data ChatMsgEvent
= XMsgNew MsgContent
| XFile FileInvitation
| XFileAcpt String
| XInfo Profile
| XContact Profile (Maybe MsgContent)
| XGrpInv GroupInvitation
| XGrpAcpt MemberId
| XGrpMemNew MemberInfo
@@ -107,22 +110,30 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
case (chatMsgEvent, chatMsgParams) of
("x.msg.new", mt : rawFiles) -> do
t <- toMsgType mt
files <- mapM (toContentInfo <=< parseAll contentInfoP) rawFiles
files <- toFiles rawFiles
chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
("x.file", [name, size, cReq]) -> do
let fileName = T.unpack $ safeDecodeUtf8 name
fileSize <- parseAll A.decimal size
fileConnReq <- parseAll connReqP cReq
fileConnReq <- parseAll connReqP' cReq
chatMsg . XFile $ FileInvitation {fileName, fileSize, fileConnReq}
("x.file.acpt", [name]) ->
chatMsg . XFileAcpt . T.unpack $ safeDecodeUtf8 name
("x.info", []) -> do
profile <- getJSON body
chatMsg $ XInfo profile
("x.con", []) -> do
profile <- getJSON body
chatMsg $ XContact profile Nothing
("x.con", mt : rawFiles) -> do
(profile, body') <- extractJSON body
t <- toMsgType mt
files <- toFiles rawFiles
chatMsg . XContact profile $ Just MsgContent {messageType = t, files, content = body'}
("x.grp.inv", [fromMemId, fromRole, memId, role, cReq]) -> do
fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
groupConnReq <- parseAll connReqP cReq
groupConnReq <- parseAll connReqP' cReq
profile <- getJSON body
chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupConnReq profile
("x.grp.acpt", [memId]) ->
@@ -164,11 +175,18 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
toMemberInfo :: ByteString -> ByteString -> [MsgContentBody] -> Either String MemberInfo
toMemberInfo memId role body = MemberInfo <$> B64.decode memId <*> toMemberRole role <*> getJSON body
toIntroInv :: ByteString -> ByteString -> Either String IntroInvitation
toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP groupConnReq <*> parseAll connReqP directConnReq
toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP' groupConnReq <*> parseAll connReqP' directConnReq
toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
toContentInfo (rawType, size) = (,size) <$> toContentType rawType
toFiles :: [ByteString] -> Either String [(ContentType, Int)]
toFiles = mapM $ toContentInfo <=< parseAll contentInfoP
getJSON :: FromJSON a => [MsgContentBody] -> Either String a
getJSON = J.eitherDecodeStrict' <=< getSimplexContentType XCJson
extractJSON :: FromJSON a => [MsgContentBody] -> Either String (a, [MsgContentBody])
extractJSON =
extractSimplexContentType XCJson >=> \(a, bs) -> do
j <- J.eitherDecodeStrict' a
pure (j, bs)
isContentType :: ContentType -> MsgContentBody -> Bool
isContentType t MsgContentBody {contentType = t'} = t == t'
@@ -181,28 +199,41 @@ getContentType t body = case find (isContentType t) body of
Just MsgContentBody {contentData} -> Right contentData
Nothing -> Left "no required content type"
extractContentType :: ContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
extractContentType t body = case findIndex (isContentType t) body of
Just i -> case splitAt i body of
(b, el : a) -> Right (contentData (el :: MsgContentBody), b ++ a)
(_, []) -> Left "no required content type" -- this can only happen if findIndex returns incorrect result
Nothing -> Left "no required content type"
getSimplexContentType :: XContentType -> [MsgContentBody] -> Either String ByteString
getSimplexContentType = getContentType . SimplexContentType
extractSimplexContentType :: XContentType -> [MsgContentBody] -> Either String (ByteString, [MsgContentBody])
extractSimplexContentType = extractContentType . SimplexContentType
rawChatMessage :: ChatMessage -> RawChatMessage
rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
case chatMsgEvent of
XMsgNew MsgContent {messageType = t, files, content} ->
let rawFiles = map (serializeContentInfo . rawContentInfo) files
in rawMsg "x.msg.new" (rawMsgType t : rawFiles) content
rawMsg "x.msg.new" (rawMsgType t : toRawFiles files) content
XFile FileInvitation {fileName, fileSize, fileConnReq} ->
rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq fileConnReq] []
rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeConnReq' fileConnReq] []
XFileAcpt fileName ->
rawMsg "x.file.acpt" [encodeUtf8 $ T.pack fileName] []
XInfo profile ->
rawMsg "x.info" [] [jsonBody profile]
XContact profile Nothing ->
rawMsg "x.con" [] [jsonBody profile]
XContact profile (Just MsgContent {messageType = t, files, content}) ->
rawMsg "x.con" (rawMsgType t : toRawFiles files) (jsonBody profile : content)
XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
let params =
[ B64.encode fromMemId,
serializeMemberRole fromRole,
B64.encode memId,
serializeMemberRole role,
serializeConnReq cReq
serializeConnReq' cReq
]
in rawMsg "x.grp.inv" params [jsonBody groupProfile]
XGrpAcpt memId ->
@@ -213,14 +244,14 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
XGrpMemIntro (MemberInfo memId role profile) ->
rawMsg "x.grp.mem.intro" [B64.encode memId, serializeMemberRole role] [jsonBody profile]
XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
let params = [B64.encode memId, serializeConnReq groupConnReq, serializeConnReq directConnReq]
let params = [B64.encode memId, serializeConnReq' groupConnReq, serializeConnReq' directConnReq]
in rawMsg "x.grp.mem.inv" params []
XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
let params =
[ B64.encode memId,
serializeMemberRole role,
serializeConnReq groupConnReq,
serializeConnReq directConnReq
serializeConnReq' groupConnReq,
serializeConnReq' directConnReq
]
in rawMsg "x.grp.mem.fwd" params [jsonBody profile]
XGrpMemInfo memId profile ->
@@ -257,6 +288,8 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
rawWithDAG body = map rawMsgBodyContent $ case chatDAG of
Nothing -> body
Just dag -> MsgContentBody {contentType = SimplexDAG, contentData = dag} : body
toRawFiles :: [(ContentType, Int)] -> [ByteString]
toRawFiles = map $ serializeContentInfo . rawContentInfo
toMsgBodyContent :: RawMsgBodyContent -> Either String MsgContentBody
toMsgBodyContent RawMsgBodyContent {contentType, contentData} = do
+219 -51
View File
@@ -28,6 +28,14 @@ module Simplex.Chat.Store
updateUserProfile,
updateContactProfile,
getUserContacts,
createUserContactLink,
getUserContactLinkConnections,
deleteUserContactLink,
getUserContactLink,
createContactRequest,
getContactRequest,
deleteContactRequest,
createAcceptedContact,
getLiveSndFileTransfers,
getLiveRcvFileTransfers,
getPendingSndChunks,
@@ -107,7 +115,7 @@ import qualified Database.SQLite.Simple as DB
import Database.SQLite.Simple.QQ (sql)
import Simplex.Chat.Protocol
import Simplex.Chat.Types
import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, ConnectionRequest)
import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, InvitationId)
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
import qualified Simplex.Messaging.Crypto as C
@@ -180,20 +188,45 @@ setActiveUser st userId = do
createDirectConnection :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> m ()
createDirectConnection st userId agentConnId =
liftIO . withTransaction st $ \db ->
void $ createConnection_ db userId agentConnId Nothing 0
void $ createContactConnection_ db userId agentConnId Nothing 0
createConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
createConnection_ db userId agentConnId viaContact connLevel = do
createContactConnection_ :: DB.Connection -> UserId -> ConnId -> Maybe Int64 -> Int -> IO Connection
createContactConnection_ db userId = createConnection_ db userId ConnContact Nothing
-- field types coincidentally match, but the first element here is user ID and not connection ID as in ConnectionRow
type InsertedConnectionRow = ConnectionRow
createConnection_ :: DB.Connection -> UserId -> ConnType -> Maybe Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
createConnection_ db userId connType entityId agentConnId viaContact connLevel = do
createdAt <- getCurrentTime
DB.execute
db
[sql|
INSERT INTO connections
(user_id, agent_conn_id, conn_status, conn_type, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?);
INSERT INTO connections (
user_id, agent_conn_id, conn_level, via_contact, conn_status, conn_type,
contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
) VALUES (?,?,?,?,?,?,?,?,?,?,?,?);
|]
(userId, agentConnId, ConnNew, ConnContact, viaContact, connLevel, createdAt)
(insertConnParams createdAt)
connId <- insertedRowId db
pure Connection {connId, agentConnId, connType = ConnContact, entityId = Nothing, viaContact, connLevel, connStatus = ConnNew, createdAt}
pure Connection {connId, agentConnId, connType, entityId, viaContact, connLevel, connStatus = ConnNew, createdAt}
where
insertConnParams :: UTCTime -> InsertedConnectionRow
insertConnParams createdAt =
( userId,
agentConnId,
connLevel,
viaContact,
ConnNew,
connType,
ent ConnContact,
ent ConnMember,
ent ConnSndFile,
ent ConnRcvFile,
ent ConnUserContact,
createdAt
)
ent ct = if connType == ct then entityId else Nothing
createDirectContact :: StoreMonad m => SQLiteStore -> UserId -> Connection -> Profile -> m ()
createDirectContact st userId Connection {connId} profile =
@@ -337,7 +370,7 @@ getContact_ db userId localDisplayName = do
db
[sql|
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM connections c
WHERE c.user_id = :user_id AND c.contact_id == :contact_id
ORDER BY c.connection_id DESC
@@ -359,6 +392,142 @@ getUserContacts st User {userId} =
contactNames <- map fromOnly <$> DB.query db "SELECT local_display_name FROM contacts WHERE user_id = ?" (Only userId)
rights <$> mapM (runExceptT . getContact_ db userId) contactNames
createUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> ConnId -> ConnReqContact -> m ()
createUserContactLink st userId agentConnId cReq =
liftIOEither . checkConstraint SEDuplicateContactLink . withTransaction st $ \db -> do
DB.execute db "INSERT INTO user_contact_links (user_id, conn_req_contact) VALUES (?, ?)" (userId, cReq)
userContactLinkId <- insertedRowId db
Right () <$ createConnection_ db userId ConnUserContact (Just userContactLinkId) agentConnId Nothing 0
getUserContactLinkConnections :: StoreMonad m => SQLiteStore -> UserId -> m [Connection]
getUserContactLinkConnections st userId =
liftIOEither . withTransaction st $ \db ->
connections
<$> DB.queryNamed
db
[sql|
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM connections c
JOIN user_contact_links uc ON c.user_contact_link_id == uc.user_contact_link_id
WHERE c.user_id = :user_id
AND uc.user_id = :user_id
AND uc.local_display_name = ''
|]
[":user_id" := userId]
where
connections [] = Left SEUserContactLinkNotFound
connections rows = Right $ map toConnection rows
deleteUserContactLink :: MonadUnliftIO m => SQLiteStore -> UserId -> m ()
deleteUserContactLink st userId =
liftIO . withTransaction st $ \db -> do
DB.execute
db
[sql|
DELETE FROM connections WHERE connection_id IN (
SELECT connection_id
FROM connections c
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = ? AND uc.local_display_name = ''
)
|]
(Only userId)
DB.executeNamed
db
[sql|
DELETE FROM display_names
WHERE user_id = :user_id
AND local_display_name in (
SELECT cr.local_display_name
FROM contact_requests cr
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id
AND uc.local_display_name = ''
)
|]
[":user_id" := userId]
DB.executeNamed
db
[sql|
DELETE FROM contact_profiles
WHERE contact_profile_id in (
SELECT cr.contact_profile_id
FROM contact_requests cr
JOIN user_contact_links uc USING (user_contact_link_id)
WHERE uc.user_id = :user_id
AND uc.local_display_name = ''
)
|]
[":user_id" := userId]
DB.execute db "DELETE FROM user_contact_links WHERE user_id = ? AND local_display_name = ''" (Only userId)
getUserContactLink :: StoreMonad m => SQLiteStore -> UserId -> m ConnReqContact
getUserContactLink st userId =
liftIOEither . withTransaction st $ \db ->
connReq
<$> DB.query
db
[sql|
SELECT conn_req_contact
FROM user_contact_links
WHERE user_id = ?
AND local_display_name = ''
|]
(Only userId)
where
connReq [Only cReq] = Right cReq
connReq _ = Left SEUserContactLinkNotFound
createContactRequest :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> InvitationId -> Profile -> m ContactName
createContactRequest st userId userContactId invId Profile {displayName, fullName} =
liftIOEither . withTransaction st $ \db ->
withLocalDisplayName db userId displayName $ \ldn -> do
DB.execute db "INSERT INTO contact_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
profileId <- insertedRowId db
DB.execute
db
[sql|
INSERT INTO contact_requests
(user_contact_link_id, agent_invitation_id, contact_profile_id, local_display_name, user_id) VALUES (?,?,?,?,?)
|]
(userContactId, invId, profileId, ldn, userId)
pure ldn
getContactRequest :: StoreMonad m => SQLiteStore -> UserId -> ContactName -> m UserContactRequest
getContactRequest st userId localDisplayName =
liftIOEither . withTransaction st $ \db ->
contactReq
<$> DB.query
db
[sql|
SELECT cr.contact_request_id, cr.agent_invitation_id, cr.user_contact_link_id,
c.agent_conn_id, cr.contact_profile_id
FROM contact_requests cr
JOIN connections c USING (user_contact_link_id)
WHERE cr.user_id = ?
AND cr.local_display_name = ?
|]
(userId, localDisplayName)
where
contactReq [(contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId)] =
Right UserContactRequest {contactRequestId, agentInvitationId, userContactLinkId, agentContactConnId, profileId, localDisplayName}
contactReq _ = Left $ SEContactRequestNotFound localDisplayName
deleteContactRequest :: MonadUnliftIO m => SQLiteStore -> UserId -> ContactName -> m ()
deleteContactRequest st userId localDisplayName =
liftIO . withTransaction st $ \db -> do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
DB.execute db "DELETE FROM display_names WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
createAcceptedContact :: MonadUnliftIO m => SQLiteStore -> UserId -> ConnId -> ContactName -> Int64 -> m ()
createAcceptedContact st userId agentConnId localDisplayName profileId =
liftIO . withTransaction st $ \db -> do
DB.execute db "DELETE FROM contact_requests WHERE user_id = ? AND local_display_name = ?" (userId, localDisplayName)
DB.execute db "INSERT INTO contacts (user_id, local_display_name, contact_profile_id) VALUES (?,?,?)" (userId, localDisplayName, profileId)
contactId <- insertedRowId db
void $ createConnection_ db userId ConnContact (Just contactId) agentConnId Nothing 0
getLiveSndFileTransfers :: MonadUnliftIO m => SQLiteStore -> User -> m [SndFileTransfer]
getLiveSndFileTransfers st User {userId} =
liftIO . withTransaction st $ \db -> do
@@ -416,7 +585,7 @@ getPendingConnections st User {userId} =
db
[sql|
SELECT connection_id, agent_conn_id, conn_level, via_contact,
conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
FROM connections
WHERE user_id = :user_id
AND conn_type = :conn_type
@@ -432,7 +601,7 @@ getContactConnections st userId displayName =
db
[sql|
SELECT c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM connections c
JOIN contacts cs ON c.contact_id == cs.contact_id
WHERE c.user_id = :user_id
@@ -444,12 +613,12 @@ getContactConnections st userId displayName =
connections [] = Left $ SEContactNotFound displayName
connections rows = Right $ map toConnection rows
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
type ConnectionRow = (Int64, ConnId, Int, Maybe Int64, ConnStatus, ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, UTCTime)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
type MaybeConnectionRow = (Maybe Int64, Maybe ConnId, Maybe Int, Maybe Int64, Maybe ConnStatus, Maybe ConnType, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe Int64, Maybe UTCTime)
toConnection :: ConnectionRow -> Connection
toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt) =
toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt) =
let entityId = entityId_ connType
in Connection {connId, agentConnId, connLevel, viaContact, connStatus, connType, entityId, createdAt}
where
@@ -458,10 +627,11 @@ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType,
entityId_ ConnMember = groupMemberId
entityId_ ConnRcvFile = rcvFileId
entityId_ ConnSndFile = sndFileId
entityId_ ConnUserContact = userContactLinkId
toMaybeConnection :: MaybeConnectionRow -> Maybe Connection
toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, Just createdAt) =
Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, createdAt)
toMaybeConnection (Just connId, Just agentConnId, Just connLevel, viaContact, Just connStatus, Just connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, Just createdAt) =
Just $ toConnection (connId, agentConnId, connLevel, viaContact, connStatus, connType, contactId, groupMemberId, sndFileId, rcvFileId, userContactLinkId, createdAt)
toMaybeConnection _ = Nothing
getMatchingContacts :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> m [Contact]
@@ -599,6 +769,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
ConnContact -> ReceivedDirectMessage c . Just <$> getContactRec_ db entId c
ConnSndFile -> SndFileConnection c <$> getConnSndFileTransfer_ db entId c
ConnRcvFile -> RcvFileConnection c <$> ExceptT (getRcvFileTransfer_ db userId entId)
ConnUserContact -> UserContactConnection c <$> getUserContact_ db entId
where
getConnection_ :: DB.Connection -> ExceptT StoreError IO Connection
getConnection_ db = ExceptT $ do
@@ -607,7 +778,7 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
db
[sql|
SELECT connection_id, agent_conn_id, conn_level, via_contact,
conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, created_at
conn_status, conn_type, contact_id, group_member_id, snd_file_id, rcv_file_id, user_contact_link_id, created_at
FROM connections
WHERE user_id = ? AND agent_conn_id = ?
|]
@@ -674,6 +845,21 @@ getConnectionChatDirection st User {userId, userContactId} agentConnId =
Just recipientDisplayName -> Right SndFileTransfer {..}
Nothing -> Left $ SESndFileInvalid fileId
sndFileTransfer_ fileId _ _ = Left $ SESndFileNotFound fileId
getUserContact_ :: DB.Connection -> Int64 -> ExceptT StoreError IO UserContact
getUserContact_ db userContactLinkId = ExceptT $ do
userContact_
<$> DB.query
db
[sql|
SELECT conn_req_contact
FROM user_contact_links
WHERE user_id = ? AND user_contact_link_id = ?
|]
(userId, userContactLinkId)
where
userContact_ :: [Only ConnReqContact] -> Either StoreError UserContact
userContact_ [Only cReq] = Right UserContact {userContactLinkId, connReqContact = cReq}
userContact_ _ = Left SEUserContactLinkNotFound
updateConnectionStatus :: MonadUnliftIO m => SQLiteStore -> Connection -> ConnStatus -> m ()
updateConnectionStatus st Connection {connId} connStatus =
@@ -717,14 +903,14 @@ getGroup :: StoreMonad m => SQLiteStore -> User -> GroupName -> m Group
getGroup st user localDisplayName =
liftIOEither . withTransaction st $ \db -> runExceptT $ fst <$> getGroup_ db user localDisplayName
getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnectionRequest)
getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
getGroup_ db User {userId, userContactId} localDisplayName = do
(g@Group {groupId}, cReq) <- getGroupRec_
allMembers <- getMembers_ groupId
(members, membership) <- liftEither $ splitUserMember_ allMembers
pure (g {members, membership}, cReq)
where
getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnectionRequest)
getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnReqInvitation)
getGroupRec_ = ExceptT $ do
toGroup
<$> DB.query
@@ -736,7 +922,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
WHERE g.local_display_name = ? AND g.user_id = ?
|]
(localDisplayName, userId)
toGroup :: [(Int64, GroupName, Text, Maybe ConnectionRequest)] -> Either StoreError (Group, Maybe ConnectionRequest)
toGroup :: [(Int64, GroupName, Text, Maybe ConnReqInvitation)] -> Either StoreError (Group, Maybe ConnReqInvitation)
toGroup [(groupId, displayName, fullName, cReq)] =
let groupProfile = GroupProfile {displayName, fullName}
in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, cReq)
@@ -751,7 +937,7 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
LEFT JOIN connections c ON c.connection_id = (
@@ -975,7 +1161,7 @@ getIntroduction_ db reMember toMember = ExceptT $ do
|]
(groupMemberId reMember, groupMemberId toMember)
where
toIntro :: [(Int64, Maybe ConnectionRequest, Maybe ConnectionRequest, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
toIntro :: [(Int64, Maybe ConnReqInvitation, Maybe ConnReqInvitation, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
toIntro [(introId, groupConnReq, directConnReq, introStatus)] =
let introInvitation = IntroInvitation <$> groupConnReq <*> directConnReq
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
@@ -985,7 +1171,7 @@ createIntroReMember :: StoreMonad m => SQLiteStore -> User -> Group -> GroupMemb
createIntroReMember st user@User {userId} group@Group {groupId} _host@GroupMember {memberContactId, activeConn} memInfo@(MemberInfo _ _ memberProfile) groupAgentConnId directAgentConnId =
liftIOEither . withTransaction st $ \db -> runExceptT $ do
let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
Connection {connId = directConnId} <- liftIO $ createConnection_ db userId directAgentConnId memberContactId cLevel
Connection {connId = directConnId} <- liftIO $ createContactConnection_ db userId directAgentConnId memberContactId cLevel
(localDisplayName, contactId, memProfileId) <- ExceptT $ createContact_ db userId directConnId memberProfile (Just groupId)
liftIO $ do
let newMember =
@@ -1007,7 +1193,7 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
liftIO . withTransaction st $ \db -> do
let cLevel = 1 + maybe 0 (connLevel :: Connection -> Int) activeConn
void $ createMemberConnection_ db userId groupMemberId groupAgentConnId viaContactId cLevel
Connection {connId = directConnId} <- createConnection_ db userId directAgentConnId viaContactId cLevel
Connection {connId = directConnId} <- createContactConnection_ db userId directAgentConnId viaContactId cLevel
contactId <- createMemberContact_ db directConnId
updateMember_ db contactId
where
@@ -1040,17 +1226,7 @@ createIntroToMemberContact st userId GroupMember {memberContactId = viaContactId
[":contact_id" := contactId, ":group_member_id" := groupMemberId]
createMemberConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> Maybe Int64 -> Int -> IO Connection
createMemberConnection_ db userId groupMemberId agentConnId viaContact connLevel = do
createdAt <- getCurrentTime
DB.execute
db
[sql|
INSERT INTO connections
(user_id, agent_conn_id, conn_status, conn_type, group_member_id, via_contact, conn_level, created_at) VALUES (?,?,?,?,?,?,?,?);
|]
(userId, agentConnId, ConnNew, ConnMember, groupMemberId, viaContact, connLevel, createdAt)
connId <- insertedRowId db
pure Connection {connId, agentConnId, connType = ConnMember, entityId = Just groupMemberId, viaContact, connLevel, connStatus = ConnNew, createdAt}
createMemberConnection_ db userId groupMemberId = createConnection_ db userId ConnMember (Just groupMemberId)
createContactMember_ :: IsContact a => DB.Connection -> User -> Int64 -> a -> (MemberId, GroupMemberRole) -> GroupMemberCategory -> GroupMemberStatus -> InvitedBy -> IO GroupMember
createContactMember_ db User {userId, userContactId} groupId userOrContact (memberId, memberRole) memberCategory memberStatus invitedBy = do
@@ -1098,7 +1274,7 @@ getViaGroupMember st User {userId, userContactId} Contact {contactId} =
m.group_member_id, m.group_id, m.member_id, m.member_role, m.member_category, m.member_status,
m.invited_by, m.local_display_name, m.contact_id, p.display_name, p.full_name,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM group_members m
JOIN contacts ct ON ct.contact_id = m.contact_id
JOIN contact_profiles p ON p.contact_profile_id = m.contact_profile_id
@@ -1128,7 +1304,7 @@ getViaGroupContact st User {userId} GroupMember {groupMemberId} =
SELECT
ct.contact_id, ct.local_display_name, p.display_name, p.full_name, ct.via_group,
c.connection_id, c.agent_conn_id, c.conn_level, c.via_contact,
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.created_at
c.conn_status, c.conn_type, c.contact_id, c.group_member_id, c.snd_file_id, c.rcv_file_id, c.user_contact_link_id, c.created_at
FROM contacts ct
JOIN contact_profiles p ON ct.contact_profile_id = p.contact_profile_id
JOIN connections c ON c.connection_id = (
@@ -1171,19 +1347,8 @@ createSndGroupFileTransfer st userId Group {groupId} ms filePath fileSize chunkS
pure fileId
createSndFileConnection_ :: DB.Connection -> UserId -> Int64 -> ConnId -> IO Connection
createSndFileConnection_ db userId fileId agentConnId = do
createdAt <- getCurrentTime
let connType = ConnSndFile
connStatus = ConnNew
DB.execute
db
[sql|
INSERT INTO connections
(user_id, snd_file_id, agent_conn_id, conn_status, conn_type, created_at) VALUES (?,?,?,?,?,?)
|]
(userId, fileId, agentConnId, connStatus, connType, createdAt)
connId <- insertedRowId db
pure Connection {connId, agentConnId, connType, entityId = Just fileId, viaContact = Nothing, connLevel = 0, connStatus, createdAt}
createSndFileConnection_ db userId fileId agentConnId =
createConnection_ db userId ConnSndFile (Just fileId) agentConnId Nothing 0
updateSndFileStatus :: MonadUnliftIO m => SQLiteStore -> SndFileTransfer -> FileStatus -> m ()
updateSndFileStatus st SndFileTransfer {fileId, connId} status =
@@ -1275,7 +1440,7 @@ getRcvFileTransfer_ db userId fileId =
(userId, fileId)
where
rcvFileTransfer ::
[(FileStatus, ConnectionRequest, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
[(FileStatus, ConnReqInvitation, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
Either StoreError RcvFileTransfer
rcvFileTransfer [(fileStatus', fileConnReq, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
let fileInv = FileInvitation {fileName, fileSize, fileConnReq}
@@ -1473,6 +1638,9 @@ data StoreError
= SEDuplicateName
| SEContactNotFound ContactName
| SEContactNotReady ContactName
| SEDuplicateContactLink
| SEUserContactLinkNotFound
| SEContactRequestNotFound ContactName
| SEGroupNotFound GroupName
| SEGroupWithoutUser
| SEDuplicateGroupMember
+31 -8
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE LambdaCase #-}
@@ -20,7 +21,7 @@ import Database.SQLite.Simple.Internal (Field (..))
import Database.SQLite.Simple.Ok (Ok (Ok))
import Database.SQLite.Simple.ToField (ToField (..))
import GHC.Generics
import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionRequest)
import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionMode (..), ConnectionRequest, InvitationId)
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
class IsContact a where
@@ -60,6 +61,22 @@ data Contact = Contact
contactConnId :: Contact -> ConnId
contactConnId Contact {activeConn = Connection {agentConnId}} = agentConnId
data UserContact = UserContact
{ userContactLinkId :: Int64,
connReqContact :: ConnReqContact
}
deriving (Eq, Show)
data UserContactRequest = UserContactRequest
{ contactRequestId :: Int64,
agentInvitationId :: InvitationId,
userContactLinkId :: Int64,
agentContactConnId :: ConnId,
localDisplayName :: ContactName,
profileId :: Int64
}
deriving (Eq, Show)
type ContactName = Text
type GroupName = Text
@@ -96,14 +113,14 @@ instance FromJSON GroupProfile
data GroupInvitation = GroupInvitation
{ fromMember :: (MemberId, GroupMemberRole),
invitedMember :: (MemberId, GroupMemberRole),
connRequest :: ConnectionRequest,
connRequest :: ConnReqInvitation,
groupProfile :: GroupProfile
}
deriving (Eq, Show)
data IntroInvitation = IntroInvitation
{ groupConnReq :: ConnectionRequest,
directConnReq :: ConnectionRequest
{ groupConnReq :: ConnReqInvitation,
directConnReq :: ConnReqInvitation
}
deriving (Eq, Show)
@@ -116,7 +133,7 @@ memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
data ReceivedGroupInvitation = ReceivedGroupInvitation
{ fromMember :: GroupMember,
userMember :: GroupMember,
connRequest :: ConnectionRequest,
connRequest :: ConnReqInvitation,
groupProfile :: GroupProfile
}
deriving (Eq, Show)
@@ -316,7 +333,7 @@ data SndFileTransfer = SndFileTransfer
data FileInvitation = FileInvitation
{ fileName :: String,
fileSize :: Integer,
fileConnReq :: ConnectionRequest
fileConnReq :: ConnReqInvitation
}
deriving (Eq, Show)
@@ -372,6 +389,10 @@ serializeFileStatus = \case
data RcvChunkStatus = RcvChunkOk | RcvChunkFinal | RcvChunkDuplicate | RcvChunkError
deriving (Eq, Show)
type ConnReqInvitation = ConnectionRequest 'CMInvitation
type ConnReqContact = ConnectionRequest 'CMContact
data Connection = Connection
{ connId :: Int64,
agentConnId :: ConnId,
@@ -379,7 +400,7 @@ data Connection = Connection
viaContact :: Maybe Int64,
connType :: ConnType,
connStatus :: ConnStatus,
entityId :: Maybe Int64, -- contact, group member or file ID
entityId :: Maybe Int64, -- contact, group member, file ID or user contact ID
createdAt :: UTCTime
}
deriving (Eq, Show)
@@ -426,7 +447,7 @@ serializeConnStatus = \case
ConnReady -> "ready"
ConnDeleted -> "deleted"
data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile
data ConnType = ConnContact | ConnMember | ConnSndFile | ConnRcvFile | ConnUserContact
deriving (Eq, Show)
instance FromField ConnType where fromField = fromTextField_ connTypeT
@@ -439,6 +460,7 @@ connTypeT = \case
"member" -> Just ConnMember
"snd_file" -> Just ConnSndFile
"rcv_file" -> Just ConnRcvFile
"user_contact" -> Just ConnUserContact
_ -> Nothing
serializeConnType :: ConnType -> Text
@@ -447,6 +469,7 @@ serializeConnType = \case
ConnMember -> "member"
ConnSndFile -> "snd_file"
ConnRcvFile -> "rcv_file"
ConnUserContact -> "user_contact"
data NewConnection = NewConnection
{ agentConnId :: ByteString,
+88 -8
View File
@@ -16,6 +16,14 @@ module Simplex.Chat.View
showContactAnotherClient,
showContactSubscribed,
showContactSubError,
showUserContactLinkCreated,
showUserContactLinkDeleted,
showUserContactLink,
showReceivedContactRequest,
showAcceptingContactRequest,
showContactRequestRejected,
showUserContactLinkSubscribed,
showUserContactLinkSubError,
showGroupSubscribed,
showGroupEmpty,
showGroupRemoved,
@@ -87,12 +95,13 @@ import Simplex.Chat.Terminal (printToTerminal)
import Simplex.Chat.Types
import Simplex.Chat.Util (safeDecodeUtf8)
import Simplex.Messaging.Agent.Protocol
import qualified Simplex.Messaging.Protocol as SMP
import System.Console.ANSI.Types
type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)
showInvitation :: ChatReader m => ConnectionRequest -> m ()
showInvitation = printToView . connReq
showInvitation :: ChatReader m => ConnReqInvitation -> m ()
showInvitation = printToView . connReqInvitation_
showChatError :: ChatReader m => ChatError -> m ()
showChatError = printToView . chatError
@@ -118,6 +127,30 @@ showContactSubscribed = printToView . contactSubscribed
showContactSubError :: ChatReader m => ContactName -> ChatError -> m ()
showContactSubError = printToView .: contactSubError
showUserContactLinkCreated :: ChatReader m => ConnReqContact -> m ()
showUserContactLinkCreated = printToView . userContactLinkCreated
showUserContactLinkDeleted :: ChatReader m => m ()
showUserContactLinkDeleted = printToView userContactLinkDeleted
showUserContactLink :: ChatReader m => ConnReqContact -> m ()
showUserContactLink = printToView . userContactLink
showReceivedContactRequest :: ChatReader m => ContactName -> Profile -> m ()
showReceivedContactRequest = printToView .: receivedContactRequest
showAcceptingContactRequest :: ChatReader m => ContactName -> m ()
showAcceptingContactRequest = printToView . acceptingContactRequest
showContactRequestRejected :: ChatReader m => ContactName -> m ()
showContactRequestRejected = printToView . contactRequestRejected
showUserContactLinkSubscribed :: ChatReader m => m ()
showUserContactLinkSubscribed = printToView ["Your address is active! To show: " <> highlight' "/sa"]
showUserContactLinkSubError :: ChatReader m => ChatError -> m ()
showUserContactLinkSubError = printToView . userContactLinkSubError
showGroupSubscribed :: ChatReader m => GroupName -> m ()
showGroupSubscribed = printToView . groupSubscribed
@@ -256,13 +289,13 @@ showContactUpdated = printToView .: contactUpdated
showMessageError :: ChatReader m => Text -> Text -> m ()
showMessageError = printToView .: messageError
connReq :: ConnectionRequest -> [StyledString]
connReq cReq =
[ "pass this connection link to your contact (via another channel): ",
connReqInvitation_ :: ConnReqInvitation -> [StyledString]
connReqInvitation_ cReq =
[ "pass this invitation link to your contact (via another channel): ",
"",
(plain . serializeConnReq) cReq,
(plain . serializeConnReq') cReq,
"",
"and ask them to connect: " <> highlight' "/c <invitation_above>"
"and ask them to connect: " <> highlight' "/c <invitation_link_above>"
]
contactDeleted :: ContactName -> [StyledString]
@@ -291,6 +324,48 @@ contactSubscribed c = [ttyContact c <> ": connected to server"]
contactSubError :: ContactName -> ChatError -> [StyledString]
contactSubError c e = [ttyContact c <> ": contact error " <> sShow e]
userContactLinkCreated :: ConnReqContact -> [StyledString]
userContactLinkCreated = connReqContact_ "Your new chat address is created!"
userContactLinkDeleted :: [StyledString]
userContactLinkDeleted =
[ "Your chat address is deleted - accepted contacts will remain connected.",
"To create a new chat address use " <> highlight' "/ad"
]
userContactLink :: ConnReqContact -> [StyledString]
userContactLink = connReqContact_ "Your chat address:"
connReqContact_ :: StyledString -> ConnReqContact -> [StyledString]
connReqContact_ intro cReq =
[ intro,
"",
(plain . serializeConnReq') cReq,
"",
"Anybody can send you contact requests with: " <> highlight' "/c <contact_link_above>",
"to show it again: " <> highlight' "/sa",
"to delete it: " <> highlight' "/da" <> " (accepted contacts will remain connected)"
]
receivedContactRequest :: ContactName -> Profile -> [StyledString]
receivedContactRequest c Profile {fullName} =
[ ttyFullName c fullName <> " wants to connect to you!",
"to accept: " <> highlight ("/ac " <> c),
"to reject: " <> highlight ("/rc " <> c) <> " (the sender will NOT be notified)"
]
acceptingContactRequest :: ContactName -> [StyledString]
acceptingContactRequest c = [ttyContact c <> ": accepting contact request..."]
contactRequestRejected :: ContactName -> [StyledString]
contactRequestRejected c = [ttyContact c <> ": contact request rejected"]
userContactLinkSubError :: ChatError -> [StyledString]
userContactLinkSubError e =
[ "user address error: " <> sShow e,
"to delete your address: " <> highlight' "/da"
]
groupSubscribed :: GroupName -> [StyledString]
groupSubscribed g = [ttyGroup g <> ": connected to server(s)"]
@@ -625,8 +700,13 @@ chatError = \case
SEFileNotFound fileId -> fileNotFound fileId
SESndFileNotFound fileId -> fileNotFound fileId
SERcvFileNotFound fileId -> fileNotFound fileId
SEDuplicateContactLink -> ["you already have chat address, to show: " <> highlight' "/sa"]
SEUserContactLinkNotFound -> ["no chat address, to create: " <> highlight' "/ad"]
SEContactRequestNotFound c -> ["no contact request from " <> ttyContact c]
e -> ["chat db error: " <> sShow e]
ChatErrorAgent e -> ["smp agent error: " <> sShow e]
ChatErrorAgent err -> case err of
SMP SMP.AUTH -> ["error: this connection is deleted"]
e -> ["smp agent error: " <> sShow e]
ChatErrorMessage e -> ["chat message error: " <> sShow e]
where
fileNotFound fileId = ["file " <> sShow fileId <> " not found"]