mirror of
https://github.com/simplex-chat/simplex-chat.git
synced 2026-03-30 16:25:57 +00:00
use ConnectionRequest syntax instead of "queue information" (#137)
This commit is contained in:
Evgeny Poberezkin
committed by
GitHub
GitHub
parent
498181b2e9
commit
e4328cb98d
@@ -69,7 +69,7 @@ data ChatCommand
|
||||
| GroupsHelp
|
||||
| MarkdownHelp
|
||||
| AddContact
|
||||
| Connect SMPQueueInfo
|
||||
| Connect ConnectionRequest
|
||||
| DeleteContact ContactName
|
||||
| SendMessage ContactName ByteString
|
||||
| NewGroup GroupProfile
|
||||
@@ -178,11 +178,11 @@ processChatCommand user@User {userId, profile} = \case
|
||||
GroupsHelp -> printToView groupsHelpInfo
|
||||
MarkdownHelp -> printToView markdownInfo
|
||||
AddContact -> do
|
||||
(connId, qInfo) <- withAgent createConnection
|
||||
(connId, cReq) <- withAgent createConnection
|
||||
withStore $ \st -> createDirectConnection st userId connId
|
||||
showInvitation qInfo
|
||||
Connect qInfo -> do
|
||||
connId <- withAgent $ \a -> joinConnection a qInfo . directMessage $ XInfo profile
|
||||
showInvitation cReq
|
||||
Connect cReq -> do
|
||||
connId <- withAgent $ \a -> joinConnection a cReq . directMessage $ XInfo profile
|
||||
withStore $ \st -> createDirectConnection st userId connId
|
||||
DeleteContact cName ->
|
||||
withStore (\st -> getContactGroupNames st userId cName) >>= \case
|
||||
@@ -213,15 +213,15 @@ processChatCommand user@User {userId, profile} = \case
|
||||
unless (memberActive membership) $ chatError CEGroupMemberNotActive
|
||||
when (isJust $ contactMember contact members) $ chatError (CEGroupDuplicateMember cName)
|
||||
gVar <- asks idsDrg
|
||||
(agentConnId, qInfo) <- withAgent createConnection
|
||||
(agentConnId, cReq) <- withAgent createConnection
|
||||
GroupMember {memberId} <- withStore $ \st -> createContactGroupMember st gVar user groupId contact memRole agentConnId
|
||||
let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) qInfo groupProfile
|
||||
let msg = XGrpInv $ GroupInvitation (userMemberId, userRole) (memberId, memRole) cReq groupProfile
|
||||
sendDirectMessage (contactConnId contact) msg
|
||||
showSentGroupInvitation gName cName
|
||||
setActive $ ActiveG gName
|
||||
JoinGroup gName -> do
|
||||
ReceivedGroupInvitation {fromMember, userMember, queueInfo} <- withStore $ \st -> getGroupInvitation st user gName
|
||||
agentConnId <- withAgent $ \a -> joinConnection a queueInfo . directMessage . XGrpAcpt $ memberId userMember
|
||||
ReceivedGroupInvitation {fromMember, userMember, connRequest} <- withStore $ \st -> getGroupInvitation st user gName
|
||||
agentConnId <- withAgent $ \a -> joinConnection a connRequest . directMessage . XGrpAcpt $ memberId userMember
|
||||
withStore $ \st -> do
|
||||
createMemberConnection st userId fromMember agentConnId
|
||||
updateGroupMemberStatus st userId fromMember GSMemAccepted
|
||||
@@ -269,8 +269,8 @@ processChatCommand user@User {userId, profile} = \case
|
||||
SendFile cName f -> do
|
||||
(fileSize, chSize) <- checkSndFile f
|
||||
contact <- withStore $ \st -> getContact st userId cName
|
||||
(agentConnId, fileQInfo) <- withAgent createConnection
|
||||
let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileQInfo}
|
||||
(agentConnId, fileConnReq) <- withAgent createConnection
|
||||
let fileInv = FileInvitation {fileName = takeFileName f, fileSize, fileConnReq}
|
||||
SndFileTransfer {fileId} <- withStore $ \st ->
|
||||
createSndFileTransfer st userId contact f fileInv agentConnId chSize
|
||||
sendDirectMessage (contactConnId contact) $ XFile fileInv
|
||||
@@ -282,17 +282,17 @@ processChatCommand user@User {userId, profile} = \case
|
||||
unless (memberActive membership) $ chatError CEGroupMemberUserRemoved
|
||||
let fileName = takeFileName f
|
||||
ms <- forM (filter memberActive members) $ \m -> do
|
||||
(connId, fileQInfo) <- withAgent createConnection
|
||||
pure (m, connId, FileInvitation {fileName, fileSize, fileQInfo})
|
||||
(connId, fileConnReq) <- withAgent createConnection
|
||||
pure (m, connId, FileInvitation {fileName, fileSize, fileConnReq})
|
||||
fileId <- withStore $ \st -> createSndGroupFileTransfer st userId group ms f fileSize chSize
|
||||
forM_ ms $ \(m, _, fileInv) ->
|
||||
traverse (`sendDirectMessage` XFile fileInv) $ memberConnId m
|
||||
showSentFileInfo fileId
|
||||
setActive $ ActiveG gName
|
||||
ReceiveFile fileId filePath_ -> do
|
||||
ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileQInfo}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
|
||||
ft@RcvFileTransfer {fileInvitation = FileInvitation {fileName, fileConnReq}, fileStatus} <- withStore $ \st -> getRcvFileTransfer st userId fileId
|
||||
unless (fileStatus == RFSNew) . chatError $ CEFileAlreadyReceiving fileName
|
||||
tryError (withAgent $ \a -> joinConnection a fileQInfo . directMessage $ XFileAcpt fileName) >>= \case
|
||||
tryError (withAgent $ \a -> joinConnection a fileConnReq . directMessage $ XFileAcpt fileName) >>= \case
|
||||
Right agentConnId -> do
|
||||
filePath <- getRcvFilePath fileId filePath_ fileName
|
||||
withStore $ \st -> acceptRcvFileTransfer st userId fileId agentConnId filePath
|
||||
@@ -803,10 +803,10 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
if isMember memId group
|
||||
then messageWarning "x.grp.mem.intro ignored: member already exists"
|
||||
else do
|
||||
(groupConnId, groupQInfo) <- withAgent createConnection
|
||||
(directConnId, directQInfo) <- withAgent createConnection
|
||||
(groupConnId, groupConnReq) <- withAgent createConnection
|
||||
(directConnId, directConnReq) <- withAgent createConnection
|
||||
newMember <- withStore $ \st -> createIntroReMember st user group m memInfo groupConnId directConnId
|
||||
let msg = XGrpMemInv memId IntroInvitation {groupQInfo, directQInfo}
|
||||
let msg = XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq}
|
||||
sendDirectMessage agentConnId msg
|
||||
withStore $ \st -> updateGroupMemberStatus st userId newMember GSMemIntroInvited
|
||||
_ -> messageError "x.grp.mem.intro can be only sent by host member"
|
||||
@@ -828,7 +828,7 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
_ -> messageError "x.grp.mem.inv can be only sent by invitee member"
|
||||
|
||||
xGrpMemFwd :: GroupName -> GroupMember -> MemberInfo -> IntroInvitation -> m ()
|
||||
xGrpMemFwd gName m memInfo@(MemberInfo memId _ _) introInv@IntroInvitation {groupQInfo, directQInfo} = do
|
||||
xGrpMemFwd gName m memInfo@(MemberInfo memId _ _) introInv@IntroInvitation {groupConnReq, directConnReq} = do
|
||||
group@Group {membership} <- withStore $ \st -> getGroup st user gName
|
||||
toMember <- case find ((== memId) . memberId) $ members group of
|
||||
-- TODO if the missed messages are correctly sent as soon as there is connection before anything else is sent
|
||||
@@ -839,8 +839,8 @@ processAgentMessage user@User {userId, profile} agentConnId agentMessage = do
|
||||
Just m' -> pure m'
|
||||
withStore $ \st -> saveMemberInvitation st toMember introInv
|
||||
let msg = XGrpMemInfo (memberId membership) profile
|
||||
groupConnId <- withAgent $ \a -> joinConnection a groupQInfo $ directMessage msg
|
||||
directConnId <- withAgent $ \a -> joinConnection a directQInfo $ directMessage msg
|
||||
groupConnId <- withAgent $ \a -> joinConnection a groupConnReq $ directMessage msg
|
||||
directConnId <- withAgent $ \a -> joinConnection a directConnReq $ directMessage msg
|
||||
withStore $ \st -> createIntroToMemberContact st userId m toMember groupConnId directConnId
|
||||
|
||||
xGrpMemDel :: GroupName -> GroupMember -> MemberId -> m ()
|
||||
@@ -1099,7 +1099,7 @@ chatCommandP =
|
||||
<|> ("/delete #" <|> "/d #") *> (DeleteGroup <$> displayName)
|
||||
<|> ("/members #" <|> "/members " <|> "/ms #" <|> "/ms ") *> (ListMembers <$> displayName)
|
||||
<|> A.char '#' *> (SendGroupMessage <$> displayName <* A.space <*> A.takeByteString)
|
||||
<|> ("/connect " <|> "/c ") *> (Connect <$> smpQueueInfoP)
|
||||
<|> ("/connect " <|> "/c ") *> (Connect <$> connReqP)
|
||||
<|> ("/connect" <|> "/c") $> AddContact
|
||||
<|> ("/delete @" <|> "/delete " <|> "/d @" <|> "/d ") *> (DeleteContact <$> displayName)
|
||||
<|> A.char '@' *> (SendMessage <$> displayName <*> (A.space *> A.takeByteString))
|
||||
|
||||
@@ -109,32 +109,32 @@ toChatMessage RawChatMessage {chatMsgId, chatMsgEvent, chatMsgParams, chatMsgBod
|
||||
t <- toMsgType mt
|
||||
files <- mapM (toContentInfo <=< parseAll contentInfoP) rawFiles
|
||||
chatMsg . XMsgNew $ MsgContent {messageType = t, files, content = body}
|
||||
("x.file", [name, size, qInfo]) -> do
|
||||
("x.file", [name, size, cReq]) -> do
|
||||
let fileName = T.unpack $ safeDecodeUtf8 name
|
||||
fileSize <- parseAll A.decimal size
|
||||
fileQInfo <- parseAll smpQueueInfoP qInfo
|
||||
chatMsg . XFile $ FileInvitation {fileName, fileSize, fileQInfo}
|
||||
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.grp.inv", [fromMemId, fromRole, memId, role, qInfo]) -> do
|
||||
("x.grp.inv", [fromMemId, fromRole, memId, role, cReq]) -> do
|
||||
fromMem <- (,) <$> B64.decode fromMemId <*> toMemberRole fromRole
|
||||
invitedMem <- (,) <$> B64.decode memId <*> toMemberRole role
|
||||
groupQInfo <- parseAll smpQueueInfoP qInfo
|
||||
groupConnReq <- parseAll connReqP cReq
|
||||
profile <- getJSON body
|
||||
chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupQInfo profile
|
||||
chatMsg . XGrpInv $ GroupInvitation fromMem invitedMem groupConnReq profile
|
||||
("x.grp.acpt", [memId]) ->
|
||||
chatMsg . XGrpAcpt =<< B64.decode memId
|
||||
("x.grp.mem.new", [memId, role]) -> do
|
||||
chatMsg . XGrpMemNew =<< toMemberInfo memId role body
|
||||
("x.grp.mem.intro", [memId, role]) ->
|
||||
chatMsg . XGrpMemIntro =<< toMemberInfo memId role body
|
||||
("x.grp.mem.inv", [memId, groupQInfo, directQInfo]) ->
|
||||
chatMsg =<< (XGrpMemInv <$> B64.decode memId <*> toIntroInv groupQInfo directQInfo)
|
||||
("x.grp.mem.fwd", [memId, role, groupQInfo, directQInfo]) -> do
|
||||
chatMsg =<< (XGrpMemFwd <$> toMemberInfo memId role body <*> toIntroInv groupQInfo directQInfo)
|
||||
("x.grp.mem.inv", [memId, groupConnReq, directConnReq]) ->
|
||||
chatMsg =<< (XGrpMemInv <$> B64.decode memId <*> toIntroInv groupConnReq directConnReq)
|
||||
("x.grp.mem.fwd", [memId, role, groupConnReq, directConnReq]) -> do
|
||||
chatMsg =<< (XGrpMemFwd <$> toMemberInfo memId role body <*> toIntroInv groupConnReq directConnReq)
|
||||
("x.grp.mem.info", [memId]) ->
|
||||
chatMsg =<< (XGrpMemInfo <$> B64.decode memId <*> getJSON body)
|
||||
("x.grp.mem.con", [memId]) ->
|
||||
@@ -164,7 +164,7 @@ 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 groupQInfo directQInfo = IntroInvitation <$> parseAll smpQueueInfoP groupQInfo <*> parseAll smpQueueInfoP directQInfo
|
||||
toIntroInv groupConnReq directConnReq = IntroInvitation <$> parseAll connReqP groupConnReq <*> parseAll connReqP directConnReq
|
||||
toContentInfo :: (RawContentType, Int) -> Either String (ContentType, Int)
|
||||
toContentInfo (rawType, size) = (,size) <$> toContentType rawType
|
||||
getJSON :: FromJSON a => [MsgContentBody] -> Either String a
|
||||
@@ -190,19 +190,19 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
|
||||
XMsgNew MsgContent {messageType = t, files, content} ->
|
||||
let rawFiles = map (serializeContentInfo . rawContentInfo) files
|
||||
in rawMsg "x.msg.new" (rawMsgType t : rawFiles) content
|
||||
XFile FileInvitation {fileName, fileSize, fileQInfo} ->
|
||||
rawMsg "x.file" [encodeUtf8 $ T.pack fileName, bshow fileSize, serializeSmpQueueInfo fileQInfo] []
|
||||
XFile FileInvitation {fileName, fileSize, 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]
|
||||
XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) qInfo groupProfile) ->
|
||||
XGrpInv (GroupInvitation (fromMemId, fromRole) (memId, role) cReq groupProfile) ->
|
||||
let params =
|
||||
[ B64.encode fromMemId,
|
||||
serializeMemberRole fromRole,
|
||||
B64.encode memId,
|
||||
serializeMemberRole role,
|
||||
serializeSmpQueueInfo qInfo
|
||||
serializeConnReq cReq
|
||||
]
|
||||
in rawMsg "x.grp.inv" params [jsonBody groupProfile]
|
||||
XGrpAcpt memId ->
|
||||
@@ -212,15 +212,15 @@ rawChatMessage ChatMessage {chatMsgId, chatMsgEvent, chatDAG} =
|
||||
in rawMsg "x.grp.mem.new" params [jsonBody profile]
|
||||
XGrpMemIntro (MemberInfo memId role profile) ->
|
||||
rawMsg "x.grp.mem.intro" [B64.encode memId, serializeMemberRole role] [jsonBody profile]
|
||||
XGrpMemInv memId IntroInvitation {groupQInfo, directQInfo} ->
|
||||
let params = [B64.encode memId, serializeSmpQueueInfo groupQInfo, serializeSmpQueueInfo directQInfo]
|
||||
XGrpMemInv memId IntroInvitation {groupConnReq, directConnReq} ->
|
||||
let params = [B64.encode memId, serializeConnReq groupConnReq, serializeConnReq directConnReq]
|
||||
in rawMsg "x.grp.mem.inv" params []
|
||||
XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupQInfo, directQInfo} ->
|
||||
XGrpMemFwd (MemberInfo memId role profile) IntroInvitation {groupConnReq, directConnReq} ->
|
||||
let params =
|
||||
[ B64.encode memId,
|
||||
serializeMemberRole role,
|
||||
serializeSmpQueueInfo groupQInfo,
|
||||
serializeSmpQueueInfo directQInfo
|
||||
serializeConnReq groupConnReq,
|
||||
serializeConnReq directConnReq
|
||||
]
|
||||
in rawMsg "x.grp.mem.fwd" params [jsonBody profile]
|
||||
XGrpMemInfo memId profile ->
|
||||
|
||||
@@ -107,7 +107,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, SMPQueueInfo)
|
||||
import Simplex.Messaging.Agent.Protocol (AParty (..), AgentMsgId, ConnId, ConnectionRequest)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (SQLiteStore (..), createSQLiteStore, withTransaction)
|
||||
import Simplex.Messaging.Agent.Store.SQLite.Migrations (Migration (..))
|
||||
import qualified Simplex.Messaging.Crypto as C
|
||||
@@ -698,14 +698,14 @@ createNewGroup st gVar user groupProfile =
|
||||
-- | creates a new group record for the group the current user was invited to
|
||||
createGroupInvitation ::
|
||||
StoreMonad m => SQLiteStore -> User -> Contact -> GroupInvitation -> m Group
|
||||
createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, queueInfo, groupProfile} =
|
||||
createGroupInvitation st user contact GroupInvitation {fromMember, invitedMember, connRequest, groupProfile} =
|
||||
liftIOEither . withTransaction st $ \db -> do
|
||||
let GroupProfile {displayName, fullName} = groupProfile
|
||||
uId = userId user
|
||||
withLocalDisplayName db uId displayName $ \localDisplayName -> do
|
||||
DB.execute db "INSERT INTO group_profiles (display_name, full_name) VALUES (?, ?)" (displayName, fullName)
|
||||
profileId <- insertedRowId db
|
||||
DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, queueInfo, uId)
|
||||
DB.execute db "INSERT INTO groups (group_profile_id, local_display_name, inv_queue_info, user_id) VALUES (?, ?, ?, ?)" (profileId, localDisplayName, connRequest, uId)
|
||||
groupId <- insertedRowId db
|
||||
member <- createContactMember_ db user groupId contact fromMember GCHostMember GSMemInvited IBUnknown
|
||||
membership <- createContactMember_ db user groupId user invitedMember GCUserMember GSMemInvited (IBContact $ contactId contact)
|
||||
@@ -717,14 +717,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 SMPQueueInfo)
|
||||
getGroup_ :: DB.Connection -> User -> GroupName -> ExceptT StoreError IO (Group, Maybe ConnectionRequest)
|
||||
getGroup_ db User {userId, userContactId} localDisplayName = do
|
||||
(g@Group {groupId}, qInfo) <- getGroupRec_
|
||||
(g@Group {groupId}, cReq) <- getGroupRec_
|
||||
allMembers <- getMembers_ groupId
|
||||
(members, membership) <- liftEither $ splitUserMember_ allMembers
|
||||
pure (g {members, membership}, qInfo)
|
||||
pure (g {members, membership}, cReq)
|
||||
where
|
||||
getGroupRec_ :: ExceptT StoreError IO (Group, Maybe SMPQueueInfo)
|
||||
getGroupRec_ :: ExceptT StoreError IO (Group, Maybe ConnectionRequest)
|
||||
getGroupRec_ = ExceptT $ do
|
||||
toGroup
|
||||
<$> DB.query
|
||||
@@ -736,10 +736,10 @@ getGroup_ db User {userId, userContactId} localDisplayName = do
|
||||
WHERE g.local_display_name = ? AND g.user_id = ?
|
||||
|]
|
||||
(localDisplayName, userId)
|
||||
toGroup :: [(Int64, GroupName, Text, Maybe SMPQueueInfo)] -> Either StoreError (Group, Maybe SMPQueueInfo)
|
||||
toGroup [(groupId, displayName, fullName, qInfo)] =
|
||||
toGroup :: [(Int64, GroupName, Text, Maybe ConnectionRequest)] -> Either StoreError (Group, Maybe ConnectionRequest)
|
||||
toGroup [(groupId, displayName, fullName, cReq)] =
|
||||
let groupProfile = GroupProfile {displayName, fullName}
|
||||
in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, qInfo)
|
||||
in Right (Group {groupId, localDisplayName, groupProfile, members = undefined, membership = undefined}, cReq)
|
||||
toGroup _ = Left $ SEGroupNotFound localDisplayName
|
||||
getMembers_ :: Int64 -> ExceptT StoreError IO [GroupMember]
|
||||
getMembers_ groupId = ExceptT $ do
|
||||
@@ -789,11 +789,11 @@ getUserGroups st user =
|
||||
getGroupInvitation :: StoreMonad m => SQLiteStore -> User -> GroupName -> m ReceivedGroupInvitation
|
||||
getGroupInvitation st user localDisplayName =
|
||||
liftIOEither . withTransaction st $ \db -> runExceptT $ do
|
||||
(Group {membership, members, groupProfile}, qInfo) <- getGroup_ db user localDisplayName
|
||||
(Group {membership, members, groupProfile}, cReq) <- getGroup_ db user localDisplayName
|
||||
when (memberStatus membership /= GSMemInvited) $ throwError SEGroupAlreadyJoined
|
||||
case (qInfo, findFromContact (invitedBy membership) members) of
|
||||
(Just queueInfo, Just fromMember) ->
|
||||
pure ReceivedGroupInvitation {fromMember, userMember = membership, queueInfo, groupProfile}
|
||||
case (cReq, findFromContact (invitedBy membership) members) of
|
||||
(Just connRequest, Just fromMember) ->
|
||||
pure ReceivedGroupInvitation {fromMember, userMember = membership, connRequest, groupProfile}
|
||||
_ -> throwError SEGroupInvitationNotFound
|
||||
where
|
||||
findFromContact :: InvitedBy -> [GroupMember] -> Maybe GroupMember
|
||||
@@ -939,14 +939,14 @@ saveIntroInvitation st reMember toMember introInv = do
|
||||
WHERE group_member_intro_id = :intro_id
|
||||
|]
|
||||
[ ":intro_status" := GMIntroInvReceived,
|
||||
":group_queue_info" := groupQInfo introInv,
|
||||
":direct_queue_info" := directQInfo introInv,
|
||||
":group_queue_info" := groupConnReq introInv,
|
||||
":direct_queue_info" := directConnReq introInv,
|
||||
":intro_id" := introId intro
|
||||
]
|
||||
pure intro {introInvitation = Just introInv, introStatus = GMIntroInvReceived}
|
||||
|
||||
saveMemberInvitation :: StoreMonad m => SQLiteStore -> GroupMember -> IntroInvitation -> m ()
|
||||
saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupQInfo, directQInfo} =
|
||||
saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupConnReq, directConnReq} =
|
||||
liftIO . withTransaction st $ \db ->
|
||||
DB.executeNamed
|
||||
db
|
||||
@@ -958,8 +958,8 @@ saveMemberInvitation st GroupMember {groupMemberId} IntroInvitation {groupQInfo,
|
||||
WHERE group_member_id = :group_member_id
|
||||
|]
|
||||
[ ":member_status" := GSMemIntroInvited,
|
||||
":group_queue_info" := groupQInfo,
|
||||
":direct_queue_info" := directQInfo,
|
||||
":group_queue_info" := groupConnReq,
|
||||
":direct_queue_info" := directConnReq,
|
||||
":group_member_id" := groupMemberId
|
||||
]
|
||||
|
||||
@@ -975,9 +975,9 @@ getIntroduction_ db reMember toMember = ExceptT $ do
|
||||
|]
|
||||
(groupMemberId reMember, groupMemberId toMember)
|
||||
where
|
||||
toIntro :: [(Int64, Maybe SMPQueueInfo, Maybe SMPQueueInfo, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
|
||||
toIntro [(introId, groupQInfo, directQInfo, introStatus)] =
|
||||
let introInvitation = IntroInvitation <$> groupQInfo <*> directQInfo
|
||||
toIntro :: [(Int64, Maybe ConnectionRequest, Maybe ConnectionRequest, GroupMemberIntroStatus)] -> Either StoreError GroupMemberIntro
|
||||
toIntro [(introId, groupConnReq, directConnReq, introStatus)] =
|
||||
let introInvitation = IntroInvitation <$> groupConnReq <*> directConnReq
|
||||
in Right GroupMemberIntro {introId, reMember, toMember, introStatus, introInvitation}
|
||||
toIntro _ = Left SEIntroNotFound
|
||||
|
||||
@@ -1236,19 +1236,19 @@ deleteSndFileChunks st SndFileTransfer {fileId, connId} =
|
||||
DB.execute db "DELETE FROM snd_file_chunks WHERE file_id = ? AND connection_id = ?" (fileId, connId)
|
||||
|
||||
createRcvFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> Contact -> FileInvitation -> Integer -> m RcvFileTransfer
|
||||
createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
|
||||
createRcvFileTransfer st userId Contact {contactId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize =
|
||||
liftIO . withTransaction st $ \db -> do
|
||||
DB.execute db "INSERT INTO files (user_id, contact_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, contactId, fileName, fileSize, chunkSize)
|
||||
fileId <- insertedRowId db
|
||||
DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileQInfo)
|
||||
DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info) VALUES (?, ?, ?)" (fileId, FSNew, fileConnReq)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
|
||||
|
||||
createRcvGroupFileTransfer :: MonadUnliftIO m => SQLiteStore -> UserId -> GroupMember -> FileInvitation -> Integer -> m RcvFileTransfer
|
||||
createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileQInfo} chunkSize =
|
||||
createRcvGroupFileTransfer st userId GroupMember {groupId, groupMemberId, localDisplayName = c} f@FileInvitation {fileName, fileSize, fileConnReq} chunkSize =
|
||||
liftIO . withTransaction st $ \db -> do
|
||||
DB.execute db "INSERT INTO files (user_id, group_id, file_name, file_size, chunk_size) VALUES (?, ?, ?, ?, ?)" (userId, groupId, fileName, fileSize, chunkSize)
|
||||
fileId <- insertedRowId db
|
||||
DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, fileQInfo, groupMemberId)
|
||||
DB.execute db "INSERT INTO rcv_files (file_id, file_status, file_queue_info, group_member_id) VALUES (?, ?, ?, ?)" (fileId, FSNew, fileConnReq, groupMemberId)
|
||||
pure RcvFileTransfer {fileId, fileInvitation = f, fileStatus = RFSNew, senderDisplayName = c, chunkSize}
|
||||
|
||||
getRcvFileTransfer :: StoreMonad m => SQLiteStore -> UserId -> Int64 -> m RcvFileTransfer
|
||||
@@ -1275,10 +1275,10 @@ getRcvFileTransfer_ db userId fileId =
|
||||
(userId, fileId)
|
||||
where
|
||||
rcvFileTransfer ::
|
||||
[(FileStatus, SMPQueueInfo, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
|
||||
[(FileStatus, ConnectionRequest, String, Integer, Integer, Maybe ContactName, Maybe ContactName, Maybe FilePath, Maybe Int64, Maybe ConnId)] ->
|
||||
Either StoreError RcvFileTransfer
|
||||
rcvFileTransfer [(fileStatus', fileQInfo, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
|
||||
let fileInv = FileInvitation {fileName, fileSize, fileQInfo}
|
||||
rcvFileTransfer [(fileStatus', fileConnReq, fileName, fileSize, chunkSize, contactName_, memberName_, filePath_, connId_, agentConnId_)] =
|
||||
let fileInv = FileInvitation {fileName, fileSize, fileConnReq}
|
||||
fileInfo = (filePath_, connId_, agentConnId_)
|
||||
in case contactName_ <|> memberName_ of
|
||||
Nothing -> Left $ SERcvFileInvalid fileId
|
||||
|
||||
@@ -20,7 +20,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, SMPQueueInfo)
|
||||
import Simplex.Messaging.Agent.Protocol (ConnId, ConnectionRequest)
|
||||
import Simplex.Messaging.Agent.Store.SQLite (fromTextField_)
|
||||
|
||||
class IsContact a where
|
||||
@@ -96,14 +96,14 @@ instance FromJSON GroupProfile
|
||||
data GroupInvitation = GroupInvitation
|
||||
{ fromMember :: (MemberId, GroupMemberRole),
|
||||
invitedMember :: (MemberId, GroupMemberRole),
|
||||
queueInfo :: SMPQueueInfo,
|
||||
connRequest :: ConnectionRequest,
|
||||
groupProfile :: GroupProfile
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data IntroInvitation = IntroInvitation
|
||||
{ groupQInfo :: SMPQueueInfo,
|
||||
directQInfo :: SMPQueueInfo
|
||||
{ groupConnReq :: ConnectionRequest,
|
||||
directConnReq :: ConnectionRequest
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
@@ -116,7 +116,7 @@ memberInfo m = MemberInfo (memberId m) (memberRole m) (memberProfile m)
|
||||
data ReceivedGroupInvitation = ReceivedGroupInvitation
|
||||
{ fromMember :: GroupMember,
|
||||
userMember :: GroupMember,
|
||||
queueInfo :: SMPQueueInfo,
|
||||
connRequest :: ConnectionRequest,
|
||||
groupProfile :: GroupProfile
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
@@ -316,7 +316,7 @@ data SndFileTransfer = SndFileTransfer
|
||||
data FileInvitation = FileInvitation
|
||||
{ fileName :: String,
|
||||
fileSize :: Integer,
|
||||
fileQInfo :: SMPQueueInfo
|
||||
fileConnReq :: ConnectionRequest
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
||||
@@ -91,8 +91,8 @@ import System.Console.ANSI.Types
|
||||
|
||||
type ChatReader m = (MonadUnliftIO m, MonadReader ChatController m)
|
||||
|
||||
showInvitation :: ChatReader m => SMPQueueInfo -> m ()
|
||||
showInvitation = printToView . invitation
|
||||
showInvitation :: ChatReader m => ConnectionRequest -> m ()
|
||||
showInvitation = printToView . connReq
|
||||
|
||||
showChatError :: ChatReader m => ChatError -> m ()
|
||||
showChatError = printToView . chatError
|
||||
@@ -256,11 +256,11 @@ showContactUpdated = printToView .: contactUpdated
|
||||
showMessageError :: ChatReader m => Text -> Text -> m ()
|
||||
showMessageError = printToView .: messageError
|
||||
|
||||
invitation :: SMPQueueInfo -> [StyledString]
|
||||
invitation qInfo =
|
||||
[ "pass this invitation to your contact (via another channel): ",
|
||||
connReq :: ConnectionRequest -> [StyledString]
|
||||
connReq cReq =
|
||||
[ "pass this connection link to your contact (via another channel): ",
|
||||
"",
|
||||
(plain . serializeSmpQueueInfo) qInfo,
|
||||
(plain . serializeConnReq) cReq,
|
||||
"",
|
||||
"and ask them to connect: " <> highlight' "/c <invitation_above>"
|
||||
]
|
||||
|
||||
@@ -40,10 +40,10 @@ extra-deps:
|
||||
- simple-logger-0.1.0@sha256:be8ede4bd251a9cac776533bae7fb643369ebd826eb948a9a18df1a8dd252ff8,1079
|
||||
- sqlite-simple-0.4.18.0@sha256:3ceea56375c0a3590c814e411a4eb86943f8d31b93b110ca159c90689b6b39e5,3002
|
||||
- terminal-0.2.0.0@sha256:de6770ecaae3197c66ac1f0db5a80cf5a5b1d3b64a66a05b50f442de5ad39570,2977
|
||||
- simplexmq-0.4.1@sha256:3a1bc40d85e4e398458e5b9b79757e0af4fe27b8ef44eb3157f7f1e07412a8e8,7640
|
||||
# - simplexmq-0.4.1@sha256:3a1bc40d85e4e398458e5b9b79757e0af4fe27b8ef44eb3157f7f1e07412a8e8,7640
|
||||
# - ../simplexmq
|
||||
# - github: simplex-chat/simplexmq
|
||||
# commit: 35e6593581e68f7b444e0f8f4fb6a2e2cc59a5ea
|
||||
- github: simplex-chat/simplexmq
|
||||
commit: 391a48d588b460d4fa06ecee0e93f0aca563b00b
|
||||
#
|
||||
# extra-deps: []
|
||||
|
||||
|
||||
@@ -659,7 +659,7 @@ getTermLine = atomically . readTQueue . termQ
|
||||
|
||||
getInvitation :: TestCC -> IO String
|
||||
getInvitation cc = do
|
||||
cc <## "pass this invitation to your contact (via another channel):"
|
||||
cc <## "pass this connection link to your contact (via another channel):"
|
||||
cc <## ""
|
||||
inv <- getTermLine cc
|
||||
cc <## ""
|
||||
|
||||
Reference in New Issue
Block a user